diff --git a/.github/actions/tests-module-aerodyn/action.yml b/.github/actions/tests-module-aerodyn/action.yml index 7dd9fb5570..950663ab85 100644 --- a/.github/actions/tests-module-aerodyn/action.yml +++ b/.github/actions/tests-module-aerodyn/action.yml @@ -18,7 +18,7 @@ runs: fi if [[ ${{ inputs.test-target }} == "regression" ]] || [[ ${{ inputs.test-target }} == "all" ]]; then - ctest -VV -R ad_ # -j7 do not run these tests in parallel due to a bug in accessing shared files + ctest -VV -R ad_ -LE python # -j7 do not run these tests in parallel due to a bug in accessing shared files fi working-directory: ${{runner.workspace}}/openfast/build diff --git a/.github/workflows/automated-dev-tests.yml b/.github/workflows/automated-dev-tests.yml index 6e199799cd..b7dd28f3cb 100644 --- a/.github/workflows/automated-dev-tests.yml +++ b/.github/workflows/automated-dev-tests.yml @@ -224,6 +224,7 @@ jobs: cmake --build . --target openfastlib -- -j ${{env.NUM_PROCS}} cmake --build . --target openfast_cpp -- -j ${{env.NUM_PROCS}} cmake --build . --target openfastcpp -- -j ${{env.NUM_PROCS}} + cmake --build . --target aerodyn_inflow_c_binding -- -j ${{env.NUM_PROCS}} cmake --build . --target ifw_c_binding -- -j ${{env.NUM_PROCS}} cmake --build . --target hydrodyn_c_binding -- -j ${{env.NUM_PROCS}} cmake --build . --target regression_test_controllers -- -j ${{env.NUM_PROCS}} @@ -415,7 +416,7 @@ jobs: - name: Install dependencies run: | python -m pip install --upgrade pip - pip install numpy "Bokeh>=2.4" + pip install numpy "Bokeh>=2.4" vtk sudo apt-get update -y sudo apt-get install -y libhdf5-dev libopenmpi-dev libyaml-cpp-dev - name: Run Interface / API tests @@ -430,6 +431,7 @@ jobs: path: | ${{runner.workspace}}/openfast/build/reg_tests/glue-codes/openfast-cpp ${{runner.workspace}}/openfast/build/reg_tests/glue-codes/python + ${{runner.workspace}}/openfast/build/reg_tests/modules/aerodyn ${{runner.workspace}}/openfast/build/reg_tests/modules/inflowwind ${{runner.workspace}}/openfast/build/reg_tests/modules/hydrodyn !${{runner.workspace}}/openfast/build/reg_tests/glue-codes/openfast-cpp/5MW_Baseline diff --git a/modules/aerodyn/CMakeLists.txt b/modules/aerodyn/CMakeLists.txt index 77ca787763..3e8d159cfa 100644 --- a/modules/aerodyn/CMakeLists.txt +++ b/modules/aerodyn/CMakeLists.txt @@ -17,6 +17,7 @@ if (GENERATE_TYPES) generate_f90_types(src/AeroAcoustics_Registry.txt ${CMAKE_CURRENT_LIST_DIR}/src/AeroAcoustics_Types.f90) generate_f90_types(src/AeroDyn_Registry.txt ${CMAKE_CURRENT_LIST_DIR}/src/AeroDyn_Types.f90) + generate_f90_types(src/AeroDyn_Inflow_Registry.txt ${CMAKE_CURRENT_LIST_DIR}/src/AeroDyn_Inflow_Types.f90) generate_f90_types(src/AirfoilInfo_Registry.txt ${CMAKE_CURRENT_LIST_DIR}/src/AirfoilInfo_Types.f90) generate_f90_types(src/BEMT_Registry.txt ${CMAKE_CURRENT_LIST_DIR}/src/BEMT_Types.f90) generate_f90_types(src/DBEMT_Registry.txt ${CMAKE_CURRENT_LIST_DIR}/src/DBEMT_Types.f90) @@ -73,6 +74,12 @@ set(FVW_LIBS_SOURCES src/FVW_VTK.f90 ) +# ADI lib +set(ADI_LIB_SOURCES + src/AeroDyn_Inflow.f90 + src/AeroDyn_Inflow_Types.f90 +) + # UnsteadyAero lib add_library(uaaerolib ${UA_LIBS_SOURCES}) target_link_libraries(uaaerolib afinfolib nwtclibs) @@ -92,6 +99,10 @@ target_link_libraries(aeroacoustics afinfolib nwtclibs) add_library(aerodynlib ${AD_LIBS_SOURCES}) target_link_libraries(aerodynlib fvwlib uaaerolib afinfolib nwtclibs aeroacoustics) +# ADI lib +add_library(adilib ${ADI_LIB_SOURCES}) +target_link_libraries(adilib aerodynlib ifwlib nwtclibs) + # AeroDyn driver set(AD_DRIVER_SOURCES src/AeroDyn_Driver.f90 @@ -100,7 +111,7 @@ set(AD_DRIVER_SOURCES ) add_executable(aerodyn_driver ${AD_DRIVER_SOURCES}) -target_link_libraries(aerodyn_driver ifwlib aerodynlib fvwlib uaaerolib afinfolib nwtclibs versioninfolib aeroacoustics ${CMAKE_DL_LIBS}) +target_link_libraries(aerodyn_driver adilib ifwlib aerodynlib fvwlib uaaerolib afinfolib nwtclibs versioninfolib aeroacoustics ${CMAKE_DL_LIBS}) # UnsteadyAero driver @@ -111,7 +122,19 @@ set(UA_DRIVER_SOURCES add_executable(unsteadyaero_driver ${UA_DRIVER_SOURCES}) target_link_libraries(unsteadyaero_driver aerodynlib fvwlib uaaerolib afinfolib nwtclibs versioninfolib ${CMAKE_DL_LIBS}) -install(TARGETS unsteadyaero_driver aerodyn_driver aerodynlib fvwlib uaaerolib afinfolib aeroacoustics + +# c-bindings interface library +set(ADI_C_SOURCES + src/AeroDyn_Inflow_C_Binding.f90 +) +add_library(aerodyn_inflow_c_binding SHARED ${ADI_C_SOURCES}) +target_link_libraries(aerodyn_inflow_c_binding adilib nwtclibs ${CMAKE_DL_LIBS}) +if(APPLE OR UNIX) + target_compile_definitions(aerodyn_inflow_c_binding PUBLIC -DIMPLICIT_DLLEXPORT) +endif() + + +install(TARGETS unsteadyaero_driver aerodyn_driver adilib aerodynlib fvwlib uaaerolib afinfolib aeroacoustics aerodyn_inflow_c_binding EXPORT "${CMAKE_PROJECT_NAME}Libraries" RUNTIME DESTINATION bin LIBRARY DESTINATION lib diff --git a/modules/aerodyn/python-lib/aerodyn_inflow_library.py b/modules/aerodyn/python-lib/aerodyn_inflow_library.py new file mode 100644 index 0000000000..e334d28e7c --- /dev/null +++ b/modules/aerodyn/python-lib/aerodyn_inflow_library.py @@ -0,0 +1,966 @@ +#********************************************************************************************************************************** +# LICENSING +# Copyright (C) 2021 National Renewable Energy Laboratory +# +# This file is part of InflowWind. +# +# Licensed under the Apache License, Version 2.0 (the "License"); +# you may not use this file except in compliance with the License. +# You may obtain a copy of the License at +# +# http://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, software +# distributed under the License is distributed on an "AS IS" BASIS, +# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +# See the License for the specific language governing permissions and +# limitations under the License. +# +#********************************************************************************************************************************** +# +# This is the Python-C interface library for AeroDyn with InflowWind. This may +# be used directly with Python based codes to call and run AeroDyn and +# InflowWind together. An example of using this library from Python is given +# in the accompanying Python driver program. Additional notes and information +# on the interfacing is included there. +# +# +from ctypes import ( + CDLL, + POINTER, + create_string_buffer, + byref, + c_byte, + c_int, + c_double, + c_float, + c_char, + c_char_p, + c_wchar, + c_wchar_p, + c_bool +) +import numpy as np +import datetime + +class AeroDynInflowLib(CDLL): + # Human readable error levels from IfW. + error_levels = { + 0: "None", + 1: "Info", + 2: "Warning", + 3: "Severe Error", + 4: "Fatal Error" + } + + # NOTE: the error message length in Fortran is controlled by the + # ErrMsgLen variable in the NWTC_Base.f90 file. If that ever + # changes, it may be necessary to update the corresponding size + # here. + error_msg_c_len = 1025 + + # NOTE: the length of the name used for any output file written by the + # HD Fortran code is 1025. + default_str_c_len = 1025 + + def __init__(self, library_path): + super().__init__(library_path) + self.library_path = library_path + + self._initialize_routines() + self.ended = False # For error handling at end + + # Input file handling + self.ADinputPass = True # Assume passing of input file as a string + self.IfWinputPass = True # Assume passing of input file as a string + + # Create buffers for class data + self.abort_error_level = 4 + self.error_status_c = c_int(0) + self.error_message_c = create_string_buffer(self.error_msg_c_len) + + # This is not sufficient for AD + #FIXME: ChanLen may not always be 20 -- could be as much as 256 + # Possible fix is to pass this length over to Fortran side. + # Also may want to convert this at some point to C_NULL_CHAR + # delimeter instead of fixed width. Future problem though. + # Number of channel names may exceeed 5000 + self._channel_names_c = create_string_buffer(20 * 8000) + self._channel_units_c = create_string_buffer(20 * 8000) + + # Initial environmental conditions + #self.MHK = false # MHK turbine type switch -- disabled for now + self.gravity = 9.80665 # Gravitational acceleration (m/s^2) + self.defFldDens = 1.225 # Air density (kg/m^3) + self.defKinVisc = 1.464E-05 # Kinematic viscosity of working fluid (m^2/s) + self.defSpdSound = 335.0 # Speed of sound in working fluid (m/s) + self.defPatm = 103500.0 # Atmospheric pressure (Pa) [used only for an MHK turbine cavitation check] + self.defPvap = 1700.0 # Vapour pressure of working fluid (Pa) [used only for an MHK turbine cavitation check] + self.WtrDpth = 0.0 # Water depth (m) + self.MSL2SWL = 0.0 # Offset between still-water level and mean sea level (m) [positive upward] + + # flags + self.storeHHVel = False + self.transposeDCM= False + + # VTK + self.WrVTK = 0 # default of no vtk output + self.WrVTK_Type = 1 # default of surface meshes + self.VTKNacDim = np.array([-2.5,-2.5,0,10,5,5], dtype="float32") # default nacelle dimension for VTK surface rendering [x0,y0,z0,Lx,Ly,Lz] (m) + self.VTKHubRad = 1.5 # default hub radius for VTK surface rendering + + # Interpolation order (must be 1: linear, or 2: quadratic) + self.InterpOrder = 1 # default of linear interpolation + + # Initial time related variables + self.dt = 0.1 # typical default for HD + self.t_start = 0.0 # initial time + self.tmax = 600.0 # typical default for HD waves FFT + #FIXME: check tmax/total_time and note exactly what is different between them. + self.total_time = 0.0 # may be longer than tmax + self.numTimeSteps= 0 + + # number of output channels + self.numChannels = 0 # Number of channels returned + + # Aero calculation method -- AeroProjMod + # APM_BEM_NoSweepPitchTwist - 1 - "Original AeroDyn model where momentum balance is done in the WithoutSweepPitchTwist system" + # APM_BEM_Polar - 2 - "Use staggered polar grid for momentum balance in each annulus" + # APM_LiftingLine - 3 - "Use the blade lifting line (i.e. the structural) orientation (currently for OLAF with VAWT)" + self.AeroProjMod = 1 + + # Initial position of hub and blades + # used for setup of AD, not used after init. + self.initHubPos = np.zeros(shape=(3),dtype=c_float) + self.initHubOrient = np.zeros(shape=(9),dtype=c_double) + self.initNacellePos = np.zeros(shape=(3),dtype=c_float) + self.initNacelleOrient = np.zeros(shape=(9),dtype=c_double) + self.numBlades = 3 + self.initRootPos = np.zeros(shape=(self.numBlades,3),dtype=c_float) + self.initRootOrient = np.zeros(shape=(self.numBlades,9),dtype=c_double) + + # Structural Mesh + # The number of nodes must be constant throughout simulation. The + # initial position is given in the initMeshPos array (resize as + # needed, should be Nx6). + # Rotations are given in radians assuming small angles. See note at + # top of this file. + self.numMeshPts = 1 + self.initMeshPos = np.zeros(shape=(self.numMeshPts,3),dtype=c_float ) # Nx3 array [x,y,z] + self.initMeshOrient = np.zeros(shape=(self.numMeshPts,9),dtype=c_double) # Nx9 array [r11,r12,r13,r21,r22,r23,r31,r32,r33] + + # OutRootName + # If HD writes a file (echo, summary, or other), use this for the + # root of the file name. + self.outRootName = "Output_ADIlib_default" + + # _initialize_routines() ------------------------------------------------------------------------------------------------------------ + def _initialize_routines(self): + self.AeroDyn_Inflow_C_Init.argtypes = [ + POINTER(c_bool), # AD input file passed as string + POINTER(c_char_p), # AD input file as string + POINTER(c_int), # AD input file string length + POINTER(c_bool), # IfW input file passed as string + POINTER(c_char_p), # IfW input file as string + POINTER(c_int), # IfW input file string length + POINTER(c_char), # OutRootName + POINTER(c_float), # gravity + POINTER(c_float), # defFldDens + POINTER(c_float), # defKinVisc + POINTER(c_float), # defSpdSound + POINTER(c_float), # defPatm + POINTER(c_float), # defPvap + POINTER(c_float), # WtrDpth + POINTER(c_float), # MSL2SWL + POINTER(c_int), # AeroProjMod + POINTER(c_int), # InterpOrder + POINTER(c_double), # t_initial + POINTER(c_double), # dt + POINTER(c_double), # tmax + POINTER(c_bool), # storeHHVel + POINTER(c_bool), # transposeDCM + POINTER(c_int), # WrVTK + POINTER(c_int), # WrVTK_Type + POINTER(c_float), # VTKNacDim + POINTER(c_float), # VTKHubRad + POINTER(c_float), # initHubPos + POINTER(c_double), # initHubOrient_flat + POINTER(c_float), # initNacellePos + POINTER(c_double), # initNacelleOrient_flat + POINTER(c_int), # numBlades + POINTER(c_float), # initRootPos_flat + POINTER(c_double), # initRootOrient_flat + POINTER(c_int), # numMeshPts + POINTER(c_float), # initMeshPos_flat + POINTER(c_double), # initMeshOrient_flat + POINTER(c_int), # number of channels + POINTER(c_char), # output channel names + POINTER(c_char), # output channel units + POINTER(c_int), # ErrStat_C + POINTER(c_char) # ErrMsg_C + ] + self.AeroDyn_Inflow_C_Init.restype = c_int + + #self.AeroDyn_Inflow_C_ReInit.argtypes = [ + # POINTER(c_double), # t_initial + # POINTER(c_double), # dt + # POINTER(c_double), # tmax + # POINTER(c_int), # ErrStat_C + # POINTER(c_char) # ErrMsg_C + #] + #self.AeroDyn_Inflow_C_ReInit.restype = c_int + + self.AeroDyn_Inflow_C_CalcOutput.argtypes = [ + POINTER(c_double), # Time_C + POINTER(c_float), # HubPos + POINTER(c_double), # HubOrient_flat + POINTER(c_float), # HubVel + POINTER(c_float), # HubAcc + POINTER(c_float), # NacPos + POINTER(c_double), # NacOrient_flat + POINTER(c_float), # NacVel + POINTER(c_float), # NacAcc + POINTER(c_float), # RootPos + POINTER(c_double), # RootOrient_flat + POINTER(c_float), # RootVel + POINTER(c_float), # RootAcc + POINTER(c_int), # numMeshPts + POINTER(c_float), # MeshPos + POINTER(c_double), # MeshOrient_flat + POINTER(c_float), # MeshVel + POINTER(c_float), # MeshAcc + POINTER(c_float), # meshFrc -- mesh forces/moments in flat array of 6*numMeshPts + POINTER(c_float), # Output Channel Values + POINTER(c_int), # ErrStat_C + POINTER(c_char) # ErrMsg_C + ] + self.AeroDyn_Inflow_C_CalcOutput.restype = c_int + + self.AeroDyn_Inflow_C_UpdateStates.argtypes = [ + POINTER(c_double), # Time_C + POINTER(c_double), # TimeNext_C + POINTER(c_float), # HubPos + POINTER(c_double), # HubOrient_flat + POINTER(c_float), # HubVel + POINTER(c_float), # HubAcc + POINTER(c_float), # NacPos + POINTER(c_double), # NacOrient_flat + POINTER(c_float), # NacVel + POINTER(c_float), # NacAcc + POINTER(c_float), # RootPos + POINTER(c_double), # RootOrient_flat + POINTER(c_float), # RootVel + POINTER(c_float), # RootAcc + POINTER(c_int), # numMeshPts + POINTER(c_float), # MeshPos + POINTER(c_double), # MeshOrient_flat + POINTER(c_float), # MeshVel + POINTER(c_float), # MeshAcc + POINTER(c_int), # ErrStat_C + POINTER(c_char) # ErrMsg_C + ] + self.AeroDyn_Inflow_C_UpdateStates.restype = c_int + + self.AeroDyn_Inflow_C_End.argtypes = [ + POINTER(c_int), # ErrStat_C + POINTER(c_char) # ErrMsg_C + ] + self.AeroDyn_Inflow_C_End.restype = c_int + + # aerodyn_inflow_init ------------------------------------------------------------------------------------------------------------ + def aerodyn_inflow_init(self, AD_input_string_array, IfW_input_string_array): + # some bookkeeping initialization + self._numChannels_c = c_int(0) + self._initNumMeshPts = self.numMeshPts + self._initNumBlades = self.numBlades + + # Primary input file will be passed as a single string joined by + # C_NULL_CHAR. + AD_input_string = '\x00'.join(AD_input_string_array) + AD_input_string = AD_input_string.encode('utf-8') + AD_input_string_length = len(AD_input_string) + + # Primary input file will be passed as a single string joined by + # C_NULL_CHAR. + IfW_input_string = '\x00'.join(IfW_input_string_array) + IfW_input_string = IfW_input_string.encode('utf-8') + IfW_input_string_length = len(IfW_input_string) + + # Rootname for ADI output files (echo etc). + _outRootName_c = create_string_buffer((self.outRootName.ljust(self.default_str_c_len)).encode('utf-8')) + + # check hub and root points for initialization + self.check_init_hubroot() + + # Check initial mesh positions + self.check_init_mesh() + + # Flatten arrays to pass + # [x2,y1,z1, x2,y2,z2 ...] + VTKNacDim_c = (c_float * len(self.VTKNacDim ))(*self.VTKNacDim ) + initHubPos_c = (c_float * len(self.initHubPos ))(*self.initHubPos ) + initHubOrient_c = (c_double * len(self.initHubOrient ))(*self.initHubOrient ) + initNacellePos_c = (c_float * len(self.initNacellePos ))(*self.initNacellePos ) + initNacelleOrient_c = (c_double * len(self.initNacelleOrient))(*self.initNacelleOrient) + initRootPos_flat_c = self.flatPosArr( self._initNumBlades, self.numBlades,self.initRootPos, 'Init','RootPos') + initRootOrient_flat_c = self.flatOrientArr(self._initNumBlades, self.numBlades,self.initRootOrient, 'Init','RootOrient') + initMeshPos_flat_c = self.flatPosArr( self._initNumMeshPts,self.numMeshPts,self.initMeshPos, 'Init','MeshPos') + initMeshOrient_flat_c = self.flatOrientArr(self._initNumMeshPts,self.numMeshPts,self.initMeshOrient,'Init','MeshOrient') + + + # call AeroDyn_Inflow_C_Init + self.AeroDyn_Inflow_C_Init( + byref(c_bool(self.ADinputPass)), # IN: AD input file is passed + c_char_p(AD_input_string), # IN: AD input file as string (or filename if ADinputPass is false) + byref(c_int(AD_input_string_length)), # IN: AD input file string length + byref(c_bool(self.IfWinputPass)), # IN: IfW input file is passed + c_char_p(IfW_input_string), # IN: IfW input file as string (or filename if IfWinputPass is false) + byref(c_int(IfW_input_string_length)), # IN: IfW input file string length + _outRootName_c, # IN: rootname for ADI file writing + byref(c_float(self.gravity)), # IN: gravity + byref(c_float(self.defFldDens)), # IN: defFldDens + byref(c_float(self.defKinVisc)), # IN: defKinVisc + byref(c_float(self.defSpdSound)), # IN: defSpdSound + byref(c_float(self.defPatm)), # IN: defPatm + byref(c_float(self.defPvap)), # IN: defPvap + byref(c_float(self.WtrDpth)), # IN: WtrDpth + byref(c_float(self.MSL2SWL)), # IN: MSL2SWL + byref(c_int(self.AeroProjMod)), # IN: AeroProjMod + byref(c_int(self.InterpOrder)), # IN: InterpOrder (1: linear, 2: quadratic) + byref(c_double(self.t_start)), # IN: time initial + byref(c_double(self.dt)), # IN: time step (dt) + byref(c_double(self.tmax)), # IN: tmax + byref(c_bool(self.storeHHVel)), # IN: storeHHVel + byref(c_bool(self.transposeDCM)), # IN: transposeDCM + byref(c_int(self.WrVTK)), # IN: WrVTK + byref(c_int(self.WrVTK_Type)), # IN: WrVTK_Type + VTKNacDim_c, # IN: VTKNacDim + byref(c_float(self.VTKHubRad)), # IN: VTKHubRad + initHubPos_c, # IN: initHubPos -- initial hub position + initHubOrient_c, # IN: initHubOrient -- initial hub orientation DCM in flat array of 9 elements + initNacellePos_c, # IN: initNacellePos -- initial hub position + initNacelleOrient_c, # IN: initNacelleOrient -- initial hub orientation DCM in flat array of 9 elements + byref(c_int(self.numBlades)), # IN: number of blades (matches number of blade root positions) + initRootPos_flat_c, # IN: initBladeRootPos -- initial node positions in flat array of 3*numBlades + initRootOrient_flat_c, # IN: initBladeRootOrient -- initial blade root orientation DCMs in flat array of 9*numBlades + byref(c_int(self.numMeshPts)), # IN: number of attachment points expected (where motions are transferred into HD) + initMeshPos_flat_c, # IN: initMeshPos -- initial node positions in flat array of 3*numMeshPts + initMeshOrient_flat_c, # IN: initMeshOrient -- initial node orientation DCMs in flat array of 9*numMeshPts + byref(self._numChannels_c), # OUT: number of channels + self._channel_names_c, # OUT: output channel names + self._channel_units_c, # OUT: output channel units + byref(self.error_status_c), # OUT: ErrStat_C + self.error_message_c # OUT: ErrMsg_C + ) + + self.check_error() + + # Initialize output channels + self.numChannels = self._numChannels_c.value + + + ## aerodyn_inflow_reinit ------------------------------------------------------------------------------------------------------------ + #def aerodyn_inflow_reinit(self): + # #FIXME: need to pass something in here I think. Not sure what. + # + # # call AeroDyn_Inflow_C_ReInit + # self.AeroDyn_Inflow_C_ReInit( + # byref(c_double(self.t_start)), # IN: time initial + # byref(c_double(self.dt)), # IN: time step (dt) + # byref(c_double(self.tmax)), # IN: tmax + # byref(self.error_status_c), # OUT: ErrStat_C + # self.error_message_c # OUT: ErrMsg_C + # ) + # + # self.check_error() + # #FIXME: anything coming out that needs handling/passing? + + + # aerodyn_inflow_calcOutput ------------------------------------------------------------------------------------------------------------ + def aerodyn_inflow_calcOutput(self, time, hubPos, hubOrient, hubVel, hubAcc, \ + nacPos, nacOrient, nacVel, nacAcc, \ + rootPos, rootOrient, rootVel, rootAcc, \ + meshPos, meshOrient, meshVel, meshAcc, \ + meshFrcMom, outputChannelValues): + + # Check input motion info + self.check_input_motions_hubNac(hubPos,hubOrient,hubVel,hubAcc,'hub') + self.check_input_motions_hubNac(nacPos,nacOrient,nacVel,nacAcc,'nacelle') + self.check_input_motions_root(rootPos,rootOrient,rootVel,rootAcc) + self.check_input_motions_mesh(meshPos,meshOrient,meshVel,meshAcc) + + _hubPos_c = (c_float * len(np.squeeze(hubPos) ))(*np.squeeze(hubPos) ) + _hubOrient_c = (c_double * len(np.squeeze(hubOrient)))(*np.squeeze(hubOrient)) + _hubVel_c = (c_float * len(np.squeeze(hubVel) ))(*np.squeeze(hubVel) ) + _hubAcc_c = (c_float * len(np.squeeze(hubAcc) ))(*np.squeeze(hubAcc) ) + _nacPos_c = (c_float * len(np.squeeze(nacPos) ))(*np.squeeze(nacPos) ) + _nacOrient_c = (c_double * len(np.squeeze(nacOrient)))(*np.squeeze(nacOrient)) + _nacVel_c = (c_float * len(np.squeeze(nacVel) ))(*np.squeeze(nacVel) ) + _nacAcc_c = (c_float * len(np.squeeze(nacAcc) ))(*np.squeeze(nacAcc) ) + # Make a flat 1D arrays of motion info: + # [x2,y1,z1, x2,y2,z2 ...] + _rootPos_flat_c = self.flatPosArr( self._initNumBlades,self.numBlades,rootPos, time,'MeshPos') + _rootOrient_flat_c = self.flatOrientArr(self._initNumBlades,self.numBlades,rootOrient,time,'MeshOrient') + _rootVel_flat_c = self.flatVelAccArr(self._initNumBlades,self.numBlades,rootVel, time,'MeshVel') + _rootAcc_flat_c = self.flatVelAccArr(self._initNumBlades,self.numBlades,rootAcc, time,'MeshAcc') + # Make a flat 1D arrays of motion info: + # [x2,y1,z1, x2,y2,z2 ...] + _meshPos_flat_c = self.flatPosArr( self._initNumMeshPts,self.numMeshPts,meshPos, time,'MeshPos') + _meshOrient_flat_c = self.flatOrientArr(self._initNumMeshPts,self.numMeshPts,meshOrient,time,'MeshOrient') + _meshVel_flat_c = self.flatVelAccArr(self._initNumMeshPts,self.numMeshPts,meshVel, time,'MeshVel') + _meshAcc_flat_c = self.flatVelAccArr(self._initNumMeshPts,self.numMeshPts,meshAcc, time,'MeshAcc') + + # Resulting Forces/moments -- [Fx1,Fy1,Fz1,Mx1,My1,Mz1, Fx2,Fy2,Fz2,Mx2,My2,Mz2 ...] + _meshFrc_flat_c = (c_float * (6 * self.numMeshPts))(0.0,) + + # Set up output channels + outputChannelValues_c = (c_float * self.numChannels)(0.0,) + + # Run AeroDyn_Inflow_C_CalcOutput + self.AeroDyn_Inflow_C_CalcOutput( + byref(c_double(time)), # IN: time at which to calculate output forces + _hubPos_c, # IN: hub positions + _hubOrient_c, # IN: hub orientations + _hubVel_c, # IN: hub velocity [TVx,TVy,TVz,RVx,RVy,RVz] + _hubAcc_c, # IN: hub acclerations [TAx,TAy,TAz,RAx,RAy,RAz] + _nacPos_c, # IN: nac positions + _nacOrient_c, # IN: nac orientations + _nacVel_c, # IN: nac velocity [TVx,TVy,TVz,RVx,RVy,RVz] + _nacAcc_c, # IN: nac acclerations [TAx,TAy,TAz,RAx,RAy,RAz] + _rootPos_flat_c, # IN: positions + _rootOrient_flat_c, # IN: Orientations (DCM) + _rootVel_flat_c, # IN: velocities at desired positions + _rootAcc_flat_c, # IN: accelerations at desired positions + byref(c_int(self.numMeshPts)), # IN: number of attachment points expected (where motions are transferred into HD) + _meshPos_flat_c, # IN: positions + _meshOrient_flat_c, # IN: Orientations (DCM) + _meshVel_flat_c, # IN: velocities at desired positions + _meshAcc_flat_c, # IN: accelerations at desired positions + _meshFrc_flat_c, # OUT: resulting forces/moments array + outputChannelValues_c, # OUT: output channel values as described in input file + byref(self.error_status_c), # OUT: ErrStat_C + self.error_message_c # OUT: ErrMsg_C + ) + + self.check_error() + + ## Reshape Force/Moment into [N,6] + count = 0 + for j in range(0,self.numMeshPts): + meshFrcMom[j,0] = _meshFrc_flat_c[count] + meshFrcMom[j,1] = _meshFrc_flat_c[count+1] + meshFrcMom[j,2] = _meshFrc_flat_c[count+2] + meshFrcMom[j,3] = _meshFrc_flat_c[count+3] + meshFrcMom[j,4] = _meshFrc_flat_c[count+4] + meshFrcMom[j,5] = _meshFrc_flat_c[count+5] + count = count + 6 + + # Convert output channel values back into python + for k in range(0,self.numChannels): + outputChannelValues[k] = float(outputChannelValues_c[k]) + + # aerodyn_inflow_updateStates ------------------------------------------------------------------------------------------------------------ + def aerodyn_inflow_updateStates(self, time, timeNext, \ + hubPos, hubOrient, hubVel, hubAcc, \ + nacPos, nacOrient, nacVel, nacAcc, \ + rootPos, rootOrient, rootVel, rootAcc, \ + meshPos, meshOrient, meshVel, meshAcc): + + # Check input motion info + self.check_input_motions_hubNac(hubPos,hubOrient,hubVel,hubAcc,'hub') + self.check_input_motions_hubNac(nacPos,nacOrient,nacVel,nacAcc,'nacelle') + self.check_input_motions_root(rootPos,rootOrient,rootVel,rootAcc) + self.check_input_motions_mesh(meshPos,meshOrient,meshVel,meshAcc) + + _hubPos_c = (c_float * len(np.squeeze(hubPos) ))(*np.squeeze(hubPos) ) + _hubOrient_c = (c_double * len(np.squeeze(hubOrient)))(*np.squeeze(hubOrient)) + _hubVel_c = (c_float * len(np.squeeze(hubVel) ))(*np.squeeze(hubVel) ) + _hubAcc_c = (c_float * len(np.squeeze(hubAcc) ))(*np.squeeze(hubAcc) ) + _nacPos_c = (c_float * len(np.squeeze(nacPos) ))(*np.squeeze(nacPos) ) + _nacOrient_c = (c_double * len(np.squeeze(nacOrient)))(*np.squeeze(nacOrient)) + _nacVel_c = (c_float * len(np.squeeze(nacVel) ))(*np.squeeze(nacVel) ) + _nacAcc_c = (c_float * len(np.squeeze(nacAcc) ))(*np.squeeze(nacAcc) ) + # Make a flat 1D arrays of motion info: + # [x2,y1,z1, x2,y2,z2 ...] + _rootPos_flat_c = self.flatPosArr( self._initNumBlades,self.numBlades,rootPos, time,'MeshPos') + _rootOrient_flat_c = self.flatOrientArr(self._initNumBlades,self.numBlades,rootOrient,time,'MeshOrient') + _rootVel_flat_c = self.flatVelAccArr(self._initNumBlades,self.numBlades,rootVel, time,'MeshVel') + _rootAcc_flat_c = self.flatVelAccArr(self._initNumBlades,self.numBlades,rootAcc, time,'MeshAcc') + # Make a flat 1D arrays of motion info: + # [x2,y1,z1, x2,y2,z2 ...] + _meshPos_flat_c = self.flatPosArr( self._initNumMeshPts,self.numMeshPts,meshPos, time,'MeshPos') + _meshOrient_flat_c = self.flatOrientArr(self._initNumMeshPts,self.numMeshPts,meshOrient,time,'MeshOrient') + _meshVel_flat_c = self.flatVelAccArr(self._initNumMeshPts,self.numMeshPts,meshVel, time,'MeshVel') + _meshAcc_flat_c = self.flatVelAccArr(self._initNumMeshPts,self.numMeshPts,meshAcc, time,'MeshAcc') + + # Resulting Forces/moments -- [Fx1,Fy1,Fz1,Mx1,My1,Mz1, Fx2,Fy2,Fz2,Mx2,My2,Mz2 ...] + _meshFrc_flat_c = (c_float * (6 * self.numMeshPts))(0.0,) + + # Run AeroDyn_Inflow_UpdateStates_c + self.AeroDyn_Inflow_C_UpdateStates( + byref(c_double(time)), # IN: time at which to calculate output forces + byref(c_double(timeNext)), # IN: time T+dt we are stepping to + _hubPos_c, # IN: hub positions + _hubOrient_c, # IN: hub orientations + _hubVel_c, # IN: hub velocity [TVx,TVy,TVz,RVx,RVy,RVz] + _hubAcc_c, # IN: hub acclerations [TAx,TAy,TAz,RAx,RAy,RAz] + _nacPos_c, # IN: nac positions + _nacOrient_c, # IN: nac orientations + _nacVel_c, # IN: nac velocity [TVx,TVy,TVz,RVx,RVy,RVz] + _nacAcc_c, # IN: nac acclerations [TAx,TAy,TAz,RAx,RAy,RAz] + _rootPos_flat_c, # IN: positions + _rootOrient_flat_c, # IN: Orientations (DCM) + _rootVel_flat_c, # IN: velocities at desired positions + _rootAcc_flat_c, # IN: accelerations at desired positions + byref(c_int(self.numMeshPts)), # IN: number of attachment points expected (where motions are transferred into HD) + _meshPos_flat_c, # IN: positions + _meshOrient_flat_c, # IN: Orientations (DCM) + _meshVel_flat_c, # IN: velocities at desired positions + _meshAcc_flat_c, # IN: accelerations at desired positions + byref(self.error_status_c), # OUT: ErrStat_C + self.error_message_c # OUT: ErrMsg_C + ) + + self.check_error() + + # aerodyn_inflow_end ------------------------------------------------------------------------------------------------------------ + def aerodyn_inflow_end(self): + if not self.ended: + self.ended = True + # Run AeroDyn_Inflow_C_End + self.AeroDyn_Inflow_C_End( + byref(self.error_status_c), + self.error_message_c + ) + + self.check_error() + + # other functions ---------------------------------------------------------------------------------------------------------- + def check_error(self): + if self.error_status_c.value == 0: + return + elif self.error_status_c.value < self.abort_error_level: + print(f"AeroDyn/InflowWind error status: {self.error_levels[self.error_status_c.value]}: {self.error_message_c.value.decode('ascii')}") + else: + print(f"AeroDyn/InflowWind error status: {self.error_levels[self.error_status_c.value]}: {self.error_message_c.value.decode('ascii')}") + self.aerodyn_inflow_end() + raise Exception("\nAeroDyn/InflowWind terminated prematurely.") + + + def flatPosArr(self,initNumMeshPts,numPts,MeshPosArr,time,name): + if initNumMeshPts != numPts: + print(f"At time {time}, the number of {name} points changed from initial value of {initNumMeshPts}. This is not permitted during the simulation.") + self.aerodyn_inflow_end() + raise Exception("\nError in calling AeroDyn/InflowWind library.") + meshPos_flat = [pp for p in MeshPosArr for pp in p] + meshPos_flat_c = (c_float * (3 * numPts))(0.0,) + for i, p in enumerate(meshPos_flat): + meshPos_flat_c[i] = c_float(p) + return meshPos_flat_c + + + def flatOrientArr(self,initNumMeshPts,numPts,MeshOrientArr,time,name): + if initNumMeshPts != numPts: + print(f"At time {time}, the number of {name} points changed from initial value of {initNumMeshPts}. This is not permitted during the simulation.") + self.aerodyn_inflow_end() + raise Exception("\nError in calling AeroDyn/InflowWind library.") + meshOrient_flat = [pp for p in MeshOrientArr for pp in p] + meshOrient_flat_c = (c_double * (9 * numPts))(0.0,) + for i, p in enumerate(meshOrient_flat): + meshOrient_flat_c[i] = c_double(p) + return meshOrient_flat_c + + + def flatVelAccArr(self,initNumMeshPts,numPts,MeshArr,time,name): + if initNumMeshPts != numPts: + print(f"At time {time}, the number of {name} points changed from initial value of {initNumMeshPts}. This is not permitted during the simulation.") + self.aerodyn_inflow_end() + raise Exception("\nError in calling AeroDyn/InflowWind library.") + # Velocity -- [Vx2,Vy1,Vz1,RVx1,RVy1,RVz1, Vx2,Vy2,Vz2,RVx2,RVy2,RVz2 ...] + meshVel_flat = [pp for p in MeshArr for pp in p] + meshVel_flat_c = (c_float * (6 * self.numMeshPts))(0.0,) + for i, p in enumerate(meshVel_flat): + meshVel_flat_c[i] = c_float(p) + return meshVel_flat_c + + + def check_init_hubroot(self): + #print("shape of initRootPos ", self.initRootPos.shape) + #print(" ndim ", np.squeeze(self.initRootPos.ndim)) + #print(" size 0 ", self.initRootPos.shape[0]) + #print(" size 1 ", self.initRootPos.shape[1]) + #print("shape of initRootOrient ", self.initRootOrient.shape) + #print(" ndim ", np.squeeze(self.initRootPos.ndim)) + #print(" size 0 ", self.initRootOrient.shape[0]) + #print(" size 1 ", self.initRootOrient.shape[1]) + #print(" float ", type(self.initRootOrient[0,0])) + #print("shape of initHubPos ", self.initHubPos.shape) + #print(" ndim ", np.squeeze(self.initHubPos.ndim)) + #print(" size 0 ", self.initHubPos.shape[0]) + #print("shape of initHubOrient ", self.initHubOrient.shape) + #print(" ndim ", np.squeeze(self.initHubOrient.ndim)) + #print(" size 0 ", self.initHubOrient.shape[0]) + #print("shape of initNacellePos ", self.initNacellePos.shape) + #print(" ndim ", np.squeeze(self.initNacellePos.ndim)) + #print(" size 0 ", self.initNacellePos.shape[0]) + #print("shape of initNacelleOrient ", self.initNacelleOrient.shape) + #print(" ndim ", np.squeeze(self.initNacelleOrient.ndim)) + #print(" size 0 ", self.initNacelleOrient.shape[0]) + if self.numBlades < 1: + print("No blades. Set numBlades to number of AD blades in the model") + self.aerodyn_inflow_end() + raise Exception("\nAeroDyn terminated prematurely.") + if self.initRootPos.shape[1] != 3: + print("Expecting a Nx3 array of blade root positions (initRootPos) with second index for [x,y,z]") + self.aerodyn_inflow_end() + raise Exception("\nAeroDyn terminated prematurely.") + if self.initRootPos.shape[0] != self.numBlades: + print("Expecting a Nx3 array of blade root positions (initRootPos) with first index for blade number") + self.aerodyn_inflow_end() + raise Exception("\nAeroDyn terminated prematurely.") + if self.initRootOrient.shape[1] != 9: + print("Expecting a Nx9 array of blade root orientations as DCMs (initRootOrient) with second index for [r11,r12,r13,r21,r22,r23,r31,r32,r33]") + self.aerodyn_inflow_end() + raise Exception("\nAeroDyn terminated prematurely.") + if self.initRootOrient.shape[0] != self.numBlades: + print("Expecting a Nx3 array of blade root orientations (initRootOrient) with first index for blade number") + self.aerodyn_inflow_end() + raise Exception("\nAeroDyn terminated prematurely.") + if np.squeeze(self.initHubPos.ndim) > 1 or self.initHubPos.shape[0] != 3: + print("Expecting a 3 element array for initHubPos [x,y,z]") + self.aerodyn_inflow_end() + raise Exception("\nAeroDyn terminated prematurely.") + if np.squeeze(self.initHubOrient.ndim) > 1 or self.initHubOrient.shape[0] != 9: + print("Expecting a 9 element array for initHubOrient DCM [r11,r12,r13,r21,r22,r23,r31,r32,r33]") + self.aerodyn_inflow_end() + raise Exception("\nAeroDyn terminated prematurely.") + if np.squeeze(self.initNacellePos.ndim) > 1 or self.initNacellePos.shape[0] != 3: + print("Expecting a 3 element array for initNacellePos [x,y,z]") + self.aerodyn_inflow_end() + raise Exception("\nAeroDyn terminated prematurely.") + if np.squeeze(self.initNacelleOrient.ndim) > 1 or self.initNacelleOrient.shape[0] != 9: + print("Expecting a 9 element array for initNacelleOrient DCM [r11,r12,r13,r21,r22,r23,r31,r32,r33]") + self.aerodyn_inflow_end() + raise Exception("\nAeroDyn terminated prematurely.") + + + def check_init_mesh(self): + #print("shape of initMeshPos ", self.initMeshPos.shape) + #print(" size 0 ", self.initMeshPos.shape[0]) + #print(" size 1 ", self.initMeshPos.shape[1]) + #print("shape of initMeshOrient ", self.initMeshOrient.shape) + #print(" size 0 ", self.initMeshOrient.shape[0]) + #print(" size 1 ", self.initMeshOrient.shape[1]) + #print(" float ", type(self.initMeshOrient[0,0])) + # initMeshPos + # Verify that the shape of initMeshPos is correct + if self.initMeshPos.shape[0] != self.initMeshOrient.shape[0]: + print("Different number of meshs in inital position and orientation arrays") + self.aerodyn_inflow_end() + raise Exception("\nAeroDyn terminated prematurely.") + if self.initMeshPos.shape[1] != 3: + print("Expecting a Nx3 array of initial mesh positions (initMeshPos) with second index for [x,y,z]") + self.aerodyn_inflow_end() + raise Exception("\nAeroDyn terminated prematurely.") + if self.initMeshPos.shape[0] != self.numMeshPts: + print("Expecting a Nx3 array of initial mesh positions (initMeshPos) with first index for mesh number.") + self.aerodyn_inflow_end() + raise Exception("\nAeroDyn terminated prematurely.") + if self.initMeshOrient.shape[1] != 9: + print("Expecting a Nx9 array of initial mesh orientations as DCMs (initMeshOrient) with second index for [r11,r12,r13,r21,r22,r23,r31,r32,r33]") + self.aerodyn_inflow_end() + raise Exception("\nAeroDyn terminated prematurely.") + if self.initMeshOrient.shape[0] != self.numMeshPts: + print("Expecting a Nx3 array of initial mesh orientations (initMeshOrient) with first index for mesh number.") + self.aerodyn_inflow_end() + raise Exception("\nAeroDyn terminated prematurely.") + + + def check_input_motions_hubNac(self,nodePos,nodeOrient,nodeVel,nodeAcc,_name): + # Verify that the shape of positions array is correct + if nodePos.size != 3: + print("Expecting a Nx3 array of "+_name+" positions with second index for [x,y,z]") + self.aerodyn_inflow_end() + raise Exception("\nAeroDyn/AeroDyn terminated prematurely.") + + # Verify that the shape of orientations array is correct + if nodeOrient.size != 9: + print("Expecting a Nx9 array of "+_name+" orientations with second index for [r11,r12,r13,r21,r22,r23,r31,r32,r33]") + self.aerodyn_inflow_end() + raise Exception("\nAeroDyn/AeroDyn terminated prematurely.") + + # Verify that the shape of velocities array is correct + if nodeVel.size != 6: + print("Expecting a Nx6 array of "+_name+" velocities with second index for [x,y,z,Rx,Ry,Rz]") + self.aerodyn_inflow_end() + raise Exception("\nAeroDyn/AeroDyn terminated prematurely.") + + # Verify that the shape of accelerations array is correct + if nodeAcc.size != 6: + print("Expecting a Nx6 array of "+_name+" accelerations with second index for [x,y,z,Rx,Ry,Rz]") + self.aerodyn_inflow_end() + raise Exception("\nAeroDyn/AeroDyn terminated prematurely.") + + def check_input_motions_root(self,rootPos,rootOrient,rootVel,rootAcc): + # make sure number of roots didn't change for some reason + if self._initNumBlades != self.numBlades: + print(f"At time {time}, the number of root points changed from initial value of {self._initNumBlades}. This is not permitted during the simulation.") + self.aerodyn_inflow_end() + raise Exception("\nError in calling AeroDyn/AeroDyn library.") + + # Verify that the shape of positions array is correct + if rootPos.shape[1] != 3: + print("Expecting a Nx3 array of root positions (rootOrient) with second index for [x,y,z]") + self.aerodyn_inflow_end() + raise Exception("\nAeroDyn/AeroDyn terminated prematurely.") + if rootPos.shape[0] != self.numBlades: + print("Expecting a Nx3 array of root positions (rootOrient) with first index for root number.") + self.aerodyn_inflow_end() + raise Exception("\nAeroDyn/AeroDyn terminated prematurely.") + + # Verify that the shape of orientations array is correct + if rootOrient.shape[1] != 9: + print("Expecting a Nx9 array of root orientations (rootPos) with second index for [r11,r12,r13,r21,r22,r23,r31,r32,r33]") + self.aerodyn_inflow_end() + raise Exception("\nAeroDyn/AeroDyn terminated prematurely.") + if rootOrient.shape[0] != self.numBlades: + print("Expecting a Nx9 array of root orientations (rootPos) with first index for root number.") + self.aerodyn_inflow_end() + raise Exception("\nAeroDyn/AeroDyn terminated prematurely.") + + # Verify that the shape of velocities array is correct + if rootVel.shape[1] != 6: + print("Expecting a Nx6 array of root velocities (rootVel) with second index for [x,y,z,Rx,Ry,Rz]") + self.aerodyn_inflow_end() + raise Exception("\nAeroDyn/AeroDyn terminated prematurely.") + if rootVel.shape[0] != self.numBlades: + print("Expecting a Nx6 array of root velocities (rootVel) with first index for root number.") + self.aerodyn_inflow_end() + raise Exception("\nAeroDyn/AeroDyn terminated prematurely.") + + # Verify that the shape of accelerations array is correct + if rootAcc.shape[1] != 6: + print("Expecting a Nx6 array of root accelerations (rootAcc) with second index for [x,y,z,Rx,Ry,Rz]") + self.aerodyn_inflow_end() + raise Exception("\nAeroDyn/AeroDyn terminated prematurely.") + if rootAcc.shape[0] != self.numBlades: + print("Expecting a Nx6 array of root accelerations (rootAcc) with first index for root number.") + self.aerodyn_inflow_end() + raise Exception("\nAeroDyn/AeroDyn terminated prematurely.") + + + def check_input_motions_mesh(self,meshPos,meshOrient,meshVel,meshAcc): + # make sure number of meshs didn't change for some reason + if self._initNumMeshPts != self.numMeshPts: + print(f"At time {time}, the number of mesh points changed from initial value of {self._initNumMeshPts}. This is not permitted during the simulation.") + self.aerodyn_inflow_end() + raise Exception("\nError in calling AeroDyn/AeroDyn library.") + + # Verify that the shape of positions array is correct + if meshPos.shape[1] != 3: + print("Expecting a Nx3 array of mesh positions (meshOrient) with second index for [x,y,z]") + self.aerodyn_inflow_end() + raise Exception("\nAeroDyn/AeroDyn terminated prematurely.") + if meshPos.shape[0] != self.numMeshPts: + print("Expecting a Nx3 array of mesh positions (meshOrient) with first index for mesh number.") + self.aerodyn_inflow_end() + raise Exception("\nAeroDyn/AeroDyn terminated prematurely.") + + # Verify that the shape of orientations array is correct + if meshOrient.shape[1] != 9: + print("Expecting a Nx9 array of mesh orientations (meshPos) with second index for [r11,r12,r13,r21,r22,r23,r31,r32,r33]") + self.aerodyn_inflow_end() + raise Exception("\nAeroDyn/AeroDyn terminated prematurely.") + if meshOrient.shape[0] != self.numMeshPts: + print("Expecting a Nx9 array of mesh orientations (meshPos) with first index for mesh number.") + self.aerodyn_inflow_end() + raise Exception("\nAeroDyn/AeroDyn terminated prematurely.") + + # Verify that the shape of velocities array is correct + if meshVel.shape[1] != 6: + print("Expecting a Nx6 array of mesh velocities (meshVel) with second index for [x,y,z,Rx,Ry,Rz]") + self.aerodyn_inflow_end() + raise Exception("\nAeroDyn/AeroDyn terminated prematurely.") + if meshVel.shape[0] != self.numMeshPts: + print("Expecting a Nx6 array of mesh velocities (meshVel) with first index for mesh number.") + self.aerodyn_inflow_end() + raise Exception("\nAeroDyn/AeroDyn terminated prematurely.") + + # Verify that the shape of accelerations array is correct + if meshAcc.shape[1] != 6: + print("Expecting a Nx6 array of mesh accelerations (meshAcc) with second index for [x,y,z,Rx,Ry,Rz]") + self.aerodyn_inflow_end() + raise Exception("\nAeroDyn/AeroDyn terminated prematurely.") + if meshAcc.shape[0] != self.numMeshPts: + print("Expecting a Nx6 array of mesh accelerations (meshAcc) with first index for mesh number.") + self.aerodyn_inflow_end() + raise Exception("\nAeroDyn/AeroDyn terminated prematurely.") + + + + @property + def output_channel_names(self): + if len(self._channel_names_c.value.split()) == 0: + return [] + output_channel_names = self._channel_names_c.value.split() + output_channel_names = [n.decode('UTF-8') for n in output_channel_names] + return output_channel_names + + @property + def output_channel_units(self): + if len(self._channel_units_c.value.split()) == 0: + return [] + output_channel_units = self._channel_units_c.value.split() + output_channel_units = [n.decode('UTF-8') for n in output_channel_units] + return output_channel_units + + +#=============================================================================== +# Helper class for debugging the interface. This will write out all the +# input position/orientation, velocities, accelerations, and the resulting +# forces and moments at each input mesh point. If all is functioning +# correctly, this will be identical to the corresponding values in the +# AeroDyn/InflowWind output channels. + +#FIXME: this is incorrect +class DriverDbg(): + """ + This is only for debugging purposes only. The input motions and resulting + forces can be written to file with this class to verify the data I/O to the + Fortran library. + When coupled to another code, the force/moment array would be passed back + to the calling code for use in the structural solver. + """ + def __init__(self,filename,numMeshPts): + self.DbgFile=open(filename,'wt') # open output file and write header info + self.numMeshPts=numMeshPts + # write file header + t_string=datetime.datetime.now() + dt_string=datetime.date.today() + self.DbgFile.write(f"## This file was generated by aerodyn_inflow_c_lib on {dt_string.strftime('%b-%d-%Y')} at {t_string.strftime('%H:%M:%S')}\n") + self.DbgFile.write(f"## This file contains the resulting forces/moments at each of {self.numMeshPts} mesh points passed into the aerodyn_inflow_c_lib\n") + self.DbgFile.write("#\n") + self.DbgFile.write("#\n") + self.DbgFile.write("#\n") + self.DbgFile.write("#\n") + f_string = "{:^25s}" + self.DbgFile.write(" Time ") + for i in range(1,self.numMeshPts+1): + f_num = "N{0:04d}_".format(i) + self.DbgFile.write(f_string.format(f_num+"x" )) + self.DbgFile.write(f_string.format(f_num+"y" )) + self.DbgFile.write(f_string.format(f_num+"z" )) + #self.DbgFile.write(f_string.format(f_num+"Rx" )) + #self.DbgFile.write(f_string.format(f_num+"Ry" )) + #self.DbgFile.write(f_string.format(f_num+"Rz" )) + self.DbgFile.write(f_string.format(f_num+"Vx" )) + self.DbgFile.write(f_string.format(f_num+"Vy" )) + self.DbgFile.write(f_string.format(f_num+"Vz" )) + self.DbgFile.write(f_string.format(f_num+"RVx")) + self.DbgFile.write(f_string.format(f_num+"RVy")) + self.DbgFile.write(f_string.format(f_num+"RVz")) + self.DbgFile.write(f_string.format(f_num+"Ax" )) + self.DbgFile.write(f_string.format(f_num+"Ay" )) + self.DbgFile.write(f_string.format(f_num+"Az" )) + self.DbgFile.write(f_string.format(f_num+"RAx")) + self.DbgFile.write(f_string.format(f_num+"RAy")) + self.DbgFile.write(f_string.format(f_num+"RAz")) + self.DbgFile.write(f_string.format(f_num+"Fx" )) + self.DbgFile.write(f_string.format(f_num+"Fy" )) + self.DbgFile.write(f_string.format(f_num+"Fz" )) + self.DbgFile.write(f_string.format(f_num+"Mx" )) + self.DbgFile.write(f_string.format(f_num+"My" )) + self.DbgFile.write(f_string.format(f_num+"Mz" )) + self.DbgFile.write("\n") + self.DbgFile.write(" (s) ") + for i in range(1,self.numMeshPts+1): + self.DbgFile.write(f_string.format("(m)" )) + self.DbgFile.write(f_string.format("(m)" )) + self.DbgFile.write(f_string.format("(m)" )) + #self.DbgFile.write(f_string.format("(rad)" )) + #self.DbgFile.write(f_string.format("(rad)" )) + #self.DbgFile.write(f_string.format("(rad)" )) + self.DbgFile.write(f_string.format("(m/s)" )) + self.DbgFile.write(f_string.format("(m/s)" )) + self.DbgFile.write(f_string.format("(m/s)" )) + self.DbgFile.write(f_string.format("(rad/s)" )) + self.DbgFile.write(f_string.format("(rad/s)" )) + self.DbgFile.write(f_string.format("(rad/s)" )) + self.DbgFile.write(f_string.format("(m/s^2)" )) + self.DbgFile.write(f_string.format("(m/s^2)" )) + self.DbgFile.write(f_string.format("(m/s^2)" )) + self.DbgFile.write(f_string.format("(rad/s^2)")) + self.DbgFile.write(f_string.format("(rad/s^2)")) + self.DbgFile.write(f_string.format("(rad/s^2)")) + self.DbgFile.write(f_string.format("(N)" )) + self.DbgFile.write(f_string.format("(N)" )) + self.DbgFile.write(f_string.format("(N)" )) + self.DbgFile.write(f_string.format("(N-m)" )) + self.DbgFile.write(f_string.format("(N-m)" )) + self.DbgFile.write(f_string.format("(N-m)" )) + self.DbgFile.write("\n") + self.opened = True + + def write(self,t,meshPos,meshVel,meshAcc,meshFrc): + t_string = "{:10.4f}" + f_string3 = "{:25.7e}"*3 + f_string6 = "{:25.7e}"*6 + self.DbgFile.write(t_string.format(t)) + for i in range(0,self.numMeshPts): + self.DbgFile.write(f_string3.format(*meshPos[i,:])) + self.DbgFile.write(f_string6.format(*meshVel[i,:])) + self.DbgFile.write(f_string6.format(*meshAcc[i,:])) + self.DbgFile.write(f_string6.format(*meshFrc[i,:])) + self.DbgFile.write("\n") + + def end(self): + if self.opened: + self.DbgFile.close() + self.opened = False + + +#=============================================================================== +# Helper class for writing channels to file. +# for the regression testing to mirror the output from the AD15 and InfowWind +# from an OpenFAST simulation. This may also have value for debugging +# interfacing to the AeroDyn_Inflow_C_Binding library + +class WriteOutChans(): + """ + This is only for testing purposes. Since we are not returning the + output channels to anything, we will write them to file. When coupled to + another code, this data would be passed back for inclusion the any output + file there. + """ + def __init__(self,filename,chan_names,chan_units): + chan_names.insert(0,'Time') # add time index header + chan_units.insert(0,'(s)') # add time index unit + self.OutFile=open(filename,'wt') # open output file and write header info + # write file header + t_string=datetime.datetime.now() + dt_string=datetime.date.today() + self.OutFile.write(f"## This file was generated by AeroDyn_Inflow_Driver on {dt_string.strftime('%b-%d-%Y')} at {t_string.strftime('%H:%M:%S')}\n") + self.OutFile.write(f"## This file contains output channels requested from the OutList section of the AD15 and IfW input files") + self.OutFile.write(f"{filename}\n") + self.OutFile.write("#\n") + self.OutFile.write("#\n") + self.OutFile.write("#\n") + self.OutFile.write("#\n") + l = len(chan_names) + f_string = "{:^15s}"+" {:^20s} "*(l-1) + self.OutFile.write(f_string.format(*chan_names) + '\n') + self.OutFile.write(f_string.format(*chan_units) + '\n') + self.opened = True + + def write(self,chan_data): + l = chan_data.shape[1] + f_string = "{:10.4f}"+"{:25.7f}"*(l-1) + for i in range(0,chan_data.shape[0]): + self.OutFile.write(f_string.format(*chan_data[i,:]) + '\n') + #if i==0: + # print(f"{chan_data[i,:]}") + + def end(self): + if self.opened: + self.OutFile.close() + self.opened = False diff --git a/modules/aerodyn/src/AeroDyn.f90 b/modules/aerodyn/src/AeroDyn.f90 index a396c26cfc..6d0380120a 100644 --- a/modules/aerodyn/src/AeroDyn.f90 +++ b/modules/aerodyn/src/AeroDyn.f90 @@ -61,6 +61,9 @@ module AeroDyn ! states(z) PUBLIC :: AD_GetOP !< Routine to pack the operating point values (for linearization) into arrays + PUBLIC :: AD_NumWindPoints !< Routine to return then number of windpoints required by AeroDyn + PUBLIC :: AD_GetExternalWind !< Set the external wind into AeroDyn inputs + PUBLIC :: AD_SetExternalWindPositions !< Set the external wind points needed by AeroDyn inputs contains !---------------------------------------------------------------------------------------------------------------------------------- @@ -6968,4 +6971,151 @@ SUBROUTINE Compute_dX(p, x_p, x_m, delta_p, delta_m, dX) END SUBROUTINE Compute_dX !---------------------------------------------------------------------------------------------------------------------------------- +!> Count number of wind points required by AeroDyn. +!! Should respect the order of AD_GetExternalWind and AD_SetExternalWindPositions +integer(IntKi) function AD_NumWindPoints(u_AD, o_AD) result(n) + type(AD_InputType), intent(in ) :: u_AD ! AeroDyn data + type(AD_OtherStateType), intent(in ) :: o_AD ! AeroDyn data + ! locals + integer(IntKi) :: k + integer(IntKi) :: iWT + n = 0 + do iWT=1, size(u_AD%rotors) + ! Blades + do k=1,size(u_AD%rotors(iWT)%BladeMotion) + n = n + u_AD%rotors(iWT)%BladeMotion(k)%NNodes + end do + ! Tower + n = n + u_AD%rotors(iWT)%TowerMotion%NNodes + ! Nacelle + if (u_AD%rotors(iWT)%NacelleMotion%Committed) then + n = n + u_AD%rotors(iWT)%NacelleMotion%NNodes ! 1 point + endif + ! Hub Motion + if (u_AD%rotors(iWT)%HubMotion%Committed) then + n = n + u_AD%rotors(iWT)%HubMotion%NNodes ! 1 point + endif + ! TailFin + n = n + u_AD%rotors(iWT)%TFinMotion%NNodes ! 1 point + enddo + if (allocated(o_AD%WakeLocationPoints)) then + n = n + size(o_AD%WakeLocationPoints, dim=2) + end if +end function AD_NumWindPoints +!---------------------------------------------------------------------------------------------------------------------------------- +!> Sets the wind calculated by InflowWind into the AeroDyn arrays ("InputSolve_IfW") +!! Should respect the order of AD_NumWindPoints and AD_SetExternalWindPositions +subroutine AD_GetExternalWind(u_AD, VelUVW, node, errStat, errMsg) + ! Passed variables + type(AD_InputType), intent(inout) :: u_AD !< AeroDyn inputs + real(ReKi), dimension(:,:), intent(in ) :: VelUVW !< Velocity array 3 x n (as typically returned by InflowWind) + integer(IntKi), intent(inout) :: node !< Counter for dimension 2 of VelUVW. Initialized by caller and returned! + integer(IntKi) :: errStat!< Error status of the operation + character(*) :: errMsg !< Error message if errStat /= ErrID_None + ! Local variables: + integer(IntKi) :: j ! Loops through nodes / elements. + integer(IntKi) :: k ! Loops through blades. + integer(IntKi) :: nNodes + integer(IntKi) :: iWT + errStat = ErrID_None + errMsg = "" + + do iWT=1,size(u_AD%rotors) + nNodes = size(u_AD%rotors(iWT)%InflowOnBlade,2) + ! Blades + do k=1,size(u_AD%rotors(iWT)%InflowOnBlade,3) + do j=1,nNodes + u_AD%rotors(iWT)%InflowOnBlade(:,j,k) = VelUVW(:,node) + node = node + 1 + end do + end do + ! Tower + if ( allocated(u_AD%rotors(iWT)%InflowOnTower) ) then + do j=1,size(u_AD%rotors(iWT)%InflowOnTower,2) + u_AD%rotors(iWT)%InflowOnTower(:,j) = VelUVW(:,node) + node = node + 1 + end do + end if + ! Nacelle + if (u_AD%rotors(iWT)%NacelleMotion%Committed) then + u_AD%rotors(iWT)%InflowOnNacelle(:) = VelUVW(:,node) + node = node + 1 + else + u_AD%rotors(iWT)%InflowOnNacelle = 0.0_ReKi + end if + ! Hub + if (u_AD%rotors(iWT)%HubMotion%NNodes > 0) then + u_AD%rotors(iWT)%InflowOnHub(:) = VelUVW(:,node) + node = node + 1 + else + u_AD%rotors(iWT)%InflowOnHub = 0.0_ReKi + end if + ! TailFin + if (u_AD%rotors(iWT)%TFinMotion%NNodes > 0) then + u_AD%rotors(iWT)%InflowOnTailFin(:) = VelUVW(:,node) + node = node + 1 + else + u_AD%rotors(iWT)%InflowOnTailFin = 0.0_ReKi + end if + enddo ! rotors + ! OLAF points + if ( allocated(u_AD%InflowWakeVel) ) then + do j=1,size(u_AD%InflowWakeVel,DIM=2) + u_AD%InflowWakeVel(:,j) = VelUVW(:,node) + node = node + 1 + end do !j, wake points + end if +end subroutine AD_GetExternalWind +!---------------------------------------------------------------------------------------------------------------------------------- +!> Set inputs for inflow wind +!! Order should match AD_NumWindPoints and AD_GetExternalWind +subroutine AD_SetExternalWindPositions(u_AD, o_AD, PosXYZ, node, errStat, errMsg) + type(AD_InputType), intent(in ) :: u_AD !< AeroDyn inputs + type(AD_OtherStateType), intent(in ) :: o_AD !< AeroDyn other states + real(ReKi), dimension(:,:), intent(inout) :: PosXYZ !< Positions + integer(IntKi), intent(inout) :: node !< Counter for dimension 2 of PosXYZ. Initialized by caller and returned! + integer(IntKi) , intent(out ) :: errStat !< Status of error message + character(*) , intent(out ) :: errMsg !< Error message if errStat /= ErrID_None + integer :: k, j, iWT + errStat = ErrID_None + errMsg = '' + + do iWT=1,size(u_AD%rotors) + ! Blade + do k = 1,size(u_AD%rotors(iWT)%BladeMotion) + do j = 1,u_AD%rotors(iWT)%BladeMotion(k)%nNodes + node = node + 1 + PosXYZ(:,node) = u_AD%rotors(iWT)%BladeMotion(k)%TranslationDisp(:,j) + u_AD%rotors(iWT)%BladeMotion(k)%Position(:,j) + end do !J = 1,p%Bldnodes ! Loop through the blade nodes / elements + end do !K = 1,p%NumBl + ! Tower + do j = 1,u_AD%rotors(iWT)%TowerMotion%nNodes + node = node + 1 + PosXYZ(:,node) = u_AD%rotors(iWT)%TowerMotion%TranslationDisp(:,J) + u_AD%rotors(iWT)%TowerMotion%Position(:,J) + end do + ! Nacelle + if (u_AD%rotors(iWT)%NacelleMotion%Committed) then + node = node + 1 + PosXYZ(:,node) = u_AD%rotors(iWT)%NacelleMotion%TranslationDisp(:,1) + u_AD%rotors(iWT)%NacelleMotion%Position(:,1) + end if + ! Hub + if (u_AD%rotors(iWT)%HubMotion%Committed) then + node = node + 1 + PosXYZ(:,node) = u_AD%rotors(iWT)%HubMotion%TranslationDisp(:,1) + u_AD%rotors(iWT)%HubMotion%Position(:,1) + end if + ! TailFin + if (u_AD%rotors(iWT)%TFinMotion%Committed) then + node = node + 1 + PosXYZ(:,node) = u_AD%rotors(iWT)%TFinMotion%TranslationDisp(:,1) + u_AD%rotors(iWT)%TFinMotion%Position(:,1) + end if + enddo ! iWT + ! vortex points from FVW in AD15 + if (allocated(o_AD%WakeLocationPoints)) then + do j = 1,size(o_AD%WakeLocationPoints,dim=2) + node = node + 1 + PosXYZ(:,node) = o_AD%WakeLocationPoints(:,j) + enddo !j, wake points + end if +end subroutine AD_SetExternalWindPositions + END MODULE AeroDyn diff --git a/modules/aerodyn/src/AeroDyn_Driver.f90 b/modules/aerodyn/src/AeroDyn_Driver.f90 index 42202c4d8c..fdc343249c 100644 --- a/modules/aerodyn/src/AeroDyn_Driver.f90 +++ b/modules/aerodyn/src/AeroDyn_Driver.f90 @@ -1,105 +1,107 @@ -!********************************************************************************************************************************** -! LICENSING -! Copyright (C) 2015-2016 National Renewable Energy Laboratory -! -! This file is part of AeroDyn. -! -! Licensed under the Apache License, Version 2.0 (the "License"); -! you may not use this file except in compliance with the License. -! You may obtain a copy of the License at -! -! http://www.apache.org/licenses/LICENSE-2.0 -! -! Unless required by applicable law or agreed to in writing, software -! distributed under the License is distributed on an "AS IS" BASIS, -! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -! See the License for the specific language governing permissions and -! limitations under the License. -! -!********************************************************************************************************************************** -program AeroDyn_Driver - use AeroDyn_Driver_Subs, only: dat, dvr_Init, dvr_InitCase, dvr_TimeStep, dvr_CleanUp, dvr_EndCase - use AeroDyn_Driver_Subs, only: idAnalysisRegular, idAnalysisTimeD, idAnalysisCombi - use NWTC_IO - use NWTC_Num, only: RunTimes, SimStatus, SimStatus_FirstTime - implicit none - ! Program variables - REAL(ReKi) :: PrevClockTime ! Clock time at start of simulation in seconds [(s)] - REAL(ReKi) :: UsrTime1 ! User CPU time for simulation initialization [(s)] - REAL(ReKi) :: UsrTime2 ! User CPU time for simulation (without intialization) [(s)] - INTEGER(IntKi) , DIMENSION(1:8) :: StrtTime ! Start time of simulation (including intialization) [-] - INTEGER(IntKi) , DIMENSION(1:8) :: SimStrtTime ! Start time of simulation (after initialization) [-] - REAL(DbKi) :: t_global ! global-loop time marker - REAL(DbKi) :: t_final ! global-loop time marker - REAL(DbKi) :: TiLstPrn ! The simulation time of the last print (to file) [(s)] - integer :: nt !< loop counter (for time step) - integer(IntKi) :: iCase ! loop counter (for driver case) - CALL DATE_AND_TIME ( Values=StrtTime ) ! Let's time the whole simulation - CALL CPU_TIME ( UsrTime1 ) ! Initial time (this zeros the start time when used as a MATLAB function) - UsrTime1 = MAX( 0.0_ReKi, UsrTime1 ) ! CPU_TIME: If a meaningful time cannot be returned, a processor-dependent negative value is returned - - dat%initialized=.false. - call dvr_Init(dat%dvr, dat%AD, dat%IW, dat%errStat, dat%errMsg); call CheckError() - - do iCase= 1,dat%dvr%numCases - - ! Initial case - call dvr_InitCase(iCase, dat%dvr, dat%AD, dat%IW, dat%errStat, dat%errMsg); call CheckError() - dat%initialized=.true. - - ! Init of time estimator - t_global=0.0_DbKi - t_final=dat%dvr%numSteps*dat%dvr%dt - if (dat%dvr%analysisType/=idAnalysisCombi) then - call SimStatus_FirstTime( TiLstPrn, PrevClockTime, SimStrtTime, UsrTime2, t_global, t_final ) - endif - - ! One time loop - do nt = 1, dat%dvr%numSteps - call dvr_TimeStep(nt, dat%dvr, dat%AD, dat%IW, dat%errStat, dat%errMsg); call CheckError() - ! Time update to screen - t_global=nt*dat%dvr%dt - if (dat%dvr%analysisType/=idAnalysisCombi) then - if (mod( nt + 1, 10 )==0) call SimStatus(TiLstPrn, PrevClockTime, t_global, t_final) - endif - end do !nt=1,numSteps - - if (dat%dvr%analysisType/=idAnalysisCombi) then - ! display runtime to screen - call RunTimes(StrtTime, UsrTime1, SimStrtTime, UsrTime2, t_global) - endif - - call dvr_EndCase(dat%dvr, dat%AD, dat%IW, dat%initialized, dat%errStat, dat%errMsg); call CheckError() - - enddo ! Loop on cases - - call dvr_End() -contains -!................................ - subroutine CheckError() - if (dat%ErrStat /= ErrID_None) then - call WrScr(TRIM(dat%errMsg)) - if (dat%errStat >= AbortErrLev) then - call dvr_End() - end if - end if - end subroutine CheckError -!................................ - subroutine dvr_End() - integer(IntKi) :: errStat2 ! local status of error message - character(ErrMsgLen) :: errMsg2 ! local error message if ErrStat /= ErrID_None - - call dvr_CleanUp(dat%dvr, dat%AD, dat%IW, dat%initialized, errStat2, errMsg2) - CALL SetErrStat(errStat2, errMsg2, dat%errStat, dat%errMsg, 'dvr_End') - - if (dat%errStat >= AbortErrLev) then - call WrScr('') - CALL ProgAbort( 'AeroDyn Driver encountered simulation error level: '& - //TRIM(GetErrStr(dat%errStat)), TrapErrors=.FALSE., TimeWait=3._ReKi ) ! wait 3 seconds (in case they double-clicked and got an error) - else - call NormStop() - end if - end subroutine dvr_End -!................................ -end program AeroDyn_Driver - +!********************************************************************************************************************************** +! LICENSING +! Copyright (C) 2015-2016 National Renewable Energy Laboratory +! +! This file is part of AeroDyn. +! +! Licensed under the Apache License, Version 2.0 (the "License"); +! you may not use this file except in compliance with the License. +! You may obtain a copy of the License at +! +! http://www.apache.org/licenses/LICENSE-2.0 +! +! Unless required by applicable law or agreed to in writing, software +! distributed under the License is distributed on an "AS IS" BASIS, +! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +! See the License for the specific language governing permissions and +! limitations under the License. +! +!********************************************************************************************************************************** +program AeroDyn_Driver + use AeroDyn_Driver_Subs, only: dat, Dvr_Init, Dvr_InitCase, Dvr_TimeStep, Dvr_CleanUp, Dvr_EndCase + use AeroDyn_Driver_Subs, only: idAnalysisRegular, idAnalysisTimeD, idAnalysisCombi + use NWTC_IO + use NWTC_Num, only: RunTimes, SimStatus, SimStatus_FirstTime + implicit none + ! Program variables + REAL(ReKi) :: PrevClockTime ! Clock time at start of simulation in seconds [(s)] + REAL(ReKi) :: UsrTime1 ! User CPU time for simulation initialization [(s)] + REAL(ReKi) :: UsrTime2 ! User CPU time for simulation (without intialization) [(s)] + INTEGER(IntKi) , DIMENSION(1:8) :: StrtTime ! Start time of simulation (including intialization) [-] + INTEGER(IntKi) , DIMENSION(1:8) :: SimStrtTime ! Start time of simulation (after initialization) [-] + REAL(DbKi) :: t_global ! global-loop time marker + REAL(DbKi) :: t_final ! global-loop time marker + REAL(DbKi) :: TiLstPrn ! The simulation time of the last print (to file) [(s)] + integer :: nt !< loop counter (for time step) + integer(IntKi) :: iCase ! loop counter (for driver case) + + CALL DATE_AND_TIME ( Values=StrtTime ) ! Let's time the whole simulation + CALL CPU_TIME ( UsrTime1 ) ! Initial time (this zeros the start time when used as a MATLAB function) + UsrTime1 = MAX( 0.0_ReKi, UsrTime1 ) ! CPU_TIME: If a meaningful time cannot be returned, a processor-dependent negative value is returned + + ! ----- + dat%initialized=.false. + call Dvr_Init(dat%dvr, dat%ADI, dat%FED, dat%errStat, dat%errMsg); call CheckError() + + do iCase= 1,dat%dvr%numCases + + ! Initial case + call Dvr_InitCase(iCase, dat%dvr, dat%ADI, dat%FED, dat%errStat, dat%errMsg); call CheckError() + dat%initialized=.true. + + ! Init of time estimator + t_global=0.0_DbKi + t_final=dat%dvr%numSteps*dat%dvr%dt + if (dat%dvr%analysisType/=idAnalysisCombi) then + call SimStatus_FirstTime( TiLstPrn, PrevClockTime, SimStrtTime, UsrTime2, t_global, t_final ) + endif + + ! One time loop + do nt = 1, dat%dvr%numSteps + call Dvr_TimeStep(nt, dat%dvr, dat%ADI, dat%FED, dat%errStat, dat%errMsg); call CheckError() + ! Time update to screen + t_global=nt*dat%dvr%dt + if (dat%dvr%analysisType/=idAnalysisCombi) then + if (mod( nt + 1, 10 )==0) call SimStatus(TiLstPrn, PrevClockTime, t_global, t_final) + endif + end do !nt=1,numSteps + + if (dat%dvr%analysisType/=idAnalysisCombi) then + ! display runtime to screen + call RunTimes(StrtTime, UsrTime1, SimStrtTime, UsrTime2, t_global) + endif + + call Dvr_EndCase(dat%dvr, dat%ADI, dat%initialized, dat%errStat, dat%errMsg); call CheckError() + + enddo ! Loop on cases + + call Dvr_End() +contains +!................................ + subroutine CheckError() + if (dat%ErrStat /= ErrID_None) then + call WrScr(TRIM(dat%errMsg)) + if (dat%errStat >= AbortErrLev) then + call Dvr_End() + end if + end if + end subroutine CheckError +!................................ + subroutine Dvr_End() + integer(IntKi) :: errStat2 ! local status of error message + character(ErrMsgLen) :: errMsg2 ! local error message if ErrStat /= ErrID_None + + call Dvr_CleanUp(dat%dvr, dat%ADI, dat%FED, dat%initialized, errStat2, errMsg2) + CALL SetErrStat(errStat2, errMsg2, dat%errStat, dat%errMsg, 'Dvr_End') + + if (dat%errStat >= AbortErrLev) then + call WrScr('') + CALL ProgAbort( 'AeroDyn Driver encountered simulation error level: '& + //TRIM(GetErrStr(dat%errStat)), TrapErrors=.FALSE., TimeWait=3._ReKi ) ! wait 3 seconds (in case they double-clicked and got an error) + else + call NormStop() + end if + end subroutine Dvr_End +!................................ +end program AeroDyn_Driver + diff --git a/modules/aerodyn/src/AeroDyn_Driver_Registry.txt b/modules/aerodyn/src/AeroDyn_Driver_Registry.txt index 9451bdd747..61ec67db6b 100644 --- a/modules/aerodyn/src/AeroDyn_Driver_Registry.txt +++ b/modules/aerodyn/src/AeroDyn_Driver_Registry.txt @@ -12,7 +12,7 @@ # ...... Include files (definitions from NWTC Library) ............................................................................ include Registry_NWTC_Library.txt usefrom AeroDyn_Registry.txt -usefrom InflowWind.txt +usefrom AeroDyn_Inflow_Registry.txt # # ..... Table of combined cases to run ....................................................................................................... typedef AeroDyn_Driver/AD_Dvr Dvr_Case ReKi HWindSpeed - - - "Hub wind speed" "m/s" @@ -28,12 +28,12 @@ typedef ^ ^ ReKi amplitu typedef ^ ^ ReKi frequency - - - "Frequency for sinusoidal motion (when DOF>0)" "-" # ...... Data for VTK surface visualization ............................................................................ -typedef AeroDyn_Driver/AD_Dvr DvrVTK_BLSurfaceType SiKi AirfoilCoords {:}{:}{:} - - "x,y coordinates for airfoil around each blade node on a blade (relative to reference)" - +# typedef AeroDyn_Driver/AD_Dvr DvrVTK_BLSurfaceType SiKi AirfoilCoords {:}{:}{:} - - "x,y coordinates for airfoil around each blade node on a blade (relative to reference)" - typedef ^ DvrVTK_SurfaceType IntKi NumSectors - - - "number of sectors in which to split circles (higher number gives smoother surface)" - typedef ^ DvrVTK_SurfaceType SiKi NacelleBox {3}{8} - - "X-Y-Z locations of 8 points that define the nacelle box, relative to the nacelle position" m typedef ^ DvrVTK_SurfaceType SiKi BaseBox {3}{8} - - "X-Y-Z locations of 8 points that define the base box" m -typedef ^ DvrVTK_SurfaceType SiKi TowerRad {:} - - "radius of each ED tower node" m -typedef ^ DvrVTK_SurfaceType DvrVTK_BLSurfaceType BladeShape {:} - - "AirfoilCoords for each blade" m +# typedef ^ DvrVTK_SurfaceType SiKi TowerRad {:} - - "radius of each ED tower node" m +# typedef ^ DvrVTK_SurfaceType DvrVTK_BLSurfaceType BladeShape {:} - - "AirfoilCoords for each blade" m # ..... Data for driver output file ....................................................................................................... typedef AeroDyn_Driver/AD_Dvr Dvr_Outputs ProgDesc AD_ver - - - "AeroDyn version information" - @@ -60,29 +60,7 @@ typedef ^ ^ SiKi VTKHubR typedef ^ ^ ReKi VTKNacDim 6 - - "Nacelle dimensions for visualization" m typedef ^ ^ SiKi VTKRefPoint 3 - - "RefPoint for VTK outputs" -# ..... AeroDyn data ....................................................................................................... -param ^ - INTEGER numInp - 2 - "Determines order of interpolation for input-output extrap (2=linear;3=quadratic)" -typedef ^ AeroDyn_Data AD_ContinuousStateType x - - - "Continuous states" -typedef ^ ^ AD_DiscreteStateType xd - - - "Discrete states" -typedef ^ ^ AD_ConstraintStateType z - - - "Constraint states" -typedef ^ ^ AD_OtherStateType OtherState - - - "Other states" -typedef ^ ^ AD_MiscVarType m - - - "misc/optimization variables" -typedef ^ ^ AD_ParameterType p - - - "Parameters" -typedef ^ ^ AD_InputType u {numInp} - - "Array of system inputs" -typedef ^ ^ AD_OutputType y - - - "System outputs" -typedef ^ ^ DbKi InputTime {numInp} - - "Array of times associated with u array" -# ..... InflowWind data ....................................................................................................... -typedef ^ InflowWind_Data InflowWind_ContinuousStateType x - - - "Continuous states" -typedef ^ ^ InflowWind_DiscreteStateType xd - - - "Discrete states" -typedef ^ ^ InflowWind_ConstraintStateType z - - - "Constraint states" -typedef ^ ^ InflowWind_OtherStateType OtherSt - - - "Other states" -typedef ^ ^ InflowWind_ParameterType p - - - "Parameters" -typedef ^ ^ InflowWind_MiscVarType m - - - "Misc/optimization variables" -typedef ^ ^ InflowWind_InputType u {2} - - "Array of inputs associated with InputTimes" -typedef ^ ^ InflowWind_OutputType y - - - "System outputs" -typedef ^ ^ DbKi InputTimes {2} - - "Array of times associated with Input Array" - -# ..... Blade data ........................................................................................................... +# ..... Blade data for driver................................................................................................. typedef ^ BladeData ReKi pitch - - - "rad" - typedef ^ ^ ReKi pitchSpeed - - - "rad/s" - typedef ^ ^ ReKi pitchAcc - - - "rad/s/s" - @@ -94,11 +72,8 @@ typedef ^ ^ IntKi motionT typedef ^ ^ IntKi iMotion - - - "Stored index to optimize time interpolation" - typedef ^ ^ ReKi motion :: - - "" "-" typedef ^ ^ character(1024) motionFileName - - - "" - -typedef ^ ^ MeshType ptMesh - - - "Point mesh for origin motion" "-" -typedef ^ ^ MeshMapType ED_P_2_AD_P_R - - - "Mesh mapping from blade to AD hub motion" -typedef ^ ^ MeshMapType AD_P_2_AD_L_B - - - "Mesh mapping from AD blade root to AD line mesh" "-" -# ... Hub data .............................................................................................................. +# ... Hub data for driver.................................................................................................... typedef ^ HubData ReKi origin_n 3 - - "" - typedef ^ ^ ReKi orientation_n 3 - - "" - typedef ^ ^ IntKi motionType - - - "" - @@ -108,11 +83,8 @@ typedef ^ ^ ReKi rotSpee typedef ^ ^ ReKi rotAcc - - - "rotor acceleration" "rad/s/s" typedef ^ ^ character(1024) motionFileName - - - "" - typedef ^ ^ ReKi motion :: - - "" "-" -typedef ^ ^ MeshType ptMesh - - - "Point mesh for origin motion" "-" -typedef ^ ^ MeshMapType ED_P_2_AD_P_H - - - "Mesh mapping from hub to AD hub motion" -typedef ^ ^ MeshMapType map2BldPt : - - "Mesh mapping from hub to bld root motion" -# ... Nacelle data .......................................................................................................... +# ... Nacelle data for driver................................................................................................ typedef ^ NacData ReKi origin_t 3 - - "" - typedef ^ ^ IntKi motionType - - - "" - typedef ^ ^ IntKi iMotion - - - "Stored index to optimize time interpolation" - @@ -121,23 +93,17 @@ typedef ^ ^ ReKi yawSpee typedef ^ ^ ReKi yawAcc - - - "yawAcceleration" "rad/s^2" typedef ^ ^ character(1024) motionFileName - - - "" - typedef ^ ^ ReKi motion :: - - "" "-" -typedef ^ ^ MeshType ptMesh - - - "Point mesh for origin motion" "-" -typedef ^ ^ MeshMapType ED_P_2_AD_P_N - - - "Mesh mapping from nacelle to AD nacelle motion" -typedef ^ ^ MeshMapType map2hubPt - - - "Mesh mapping from Nacelle to hub" -# ... Tower data ............................................................................................................ +# ... Tower data for driver ................................................................................................. typedef ^ TwrData ReKi origin_t 3 - - "" - -typedef ^ ^ MeshType ptMesh - - - "Point mesh for origin motion" "-" -typedef ^ ^ MeshType ptMeshAD - - - "Point mesh for origin motion" "-" -typedef ^ ^ MeshMapType ED_P_2_AD_P_T - - - "Mesh mapping from tower base to AD tower base" -typedef ^ ^ MeshMapType AD_P_2_AD_L_T - - - "Mesh mapping from tower base to AD tower line" -# ..... Wind Turbine data ................................................................................................... +# ..... Wind Turbine data for driver ........................................................................................ typedef ^ WTData ReKi originInit 3 - - "" - typedef ^ ^ ReKi orientationInit 3 - - "" - -typedef ^ ^ MeshType ptMesh - - - "Point mesh for origin motion" "-" typedef ^ ^ MeshMapType map2twrPt - - - "Mesh mapping from base to tower" typedef ^ ^ MeshMapType map2nacPt - - - "Mesh mapping from base to nacelle" +typedef ^ ^ MeshMapType map2hubPt - - - "Mesh mapping from Nacelle to hub" +typedef ^ ^ MeshMapType map2BldPt : - - "Mesh mapping from hub to bld root motion" typedef ^ ^ BladeData bld : - - "" - typedef ^ ^ HubData hub - - - "" - typedef ^ ^ NacData nac - - - "" - @@ -155,10 +121,11 @@ typedef ^ ^ ReKi amplitu typedef ^ ^ ReKi frequency - - - "" - typedef ^ ^ character(1024) motionFileName - - - "" - typedef ^ ^ ReKi WriteOutput : - - "WriteOutputs of the driver only" +typedef ^ ^ ReKi userSwapArray : - - "Array to store user data for user-defined functions" "-" + # ..... Data for driver simulation ....................................................................................................... typedef ^ Dvr_SimData character(1024) AD_InputFile - - - "Name of AeroDyn input file" - -typedef ^ ^ character(1024) IW_InputFile - - - "Name of InfloWind input file" - typedef ^ ^ IntKi MHK - - - "MHK turbine type (switch) {0: not an MHK turbine, 1: fixed MHK turbine, 2: floating MHK turbine}" "-" typedef ^ ^ IntKi AnalysisType - - - "0=Steady Wind, 1=InflowWind" "-" typedef ^ ^ ReKi FldDens - - - "Density of working fluid" "kg/m^3" @@ -168,12 +135,8 @@ typedef ^ ^ ReKi Patm typedef ^ ^ ReKi Pvap - - - "Vapour pressure of working fluid" "Pa" typedef ^ ^ ReKi WtrDpth - - - "Water depth" "m" typedef ^ ^ ReKi MSL2SWL - - - "Offset between still-water level and mean sea level" "m" -typedef ^ ^ IntKi CompInflow - - - "0=Steady Wind, 1=InflowWind" "-" -typedef ^ ^ ReKi HWindSpeed - - - "RefHeight Wind speed" -typedef ^ ^ ReKi RefHt - - - "RefHeight" -typedef ^ ^ ReKi PLExp - - - "PLExp" typedef ^ ^ IntKi numTurbines - - - "number of blades on turbine" "-" -typedef ^ ^ WTData WT : - - "Wind turbine data" "-" +typedef ^ ^ WTData WT : - - "Wind turbine data for driver" "-" typedef ^ ^ DbKi dT - - - "time increment" "s" typedef ^ ^ DbKi tMax - - - "time increment" "s" typedef ^ ^ IntKi numSteps - - - "number of steps in this case" "-" @@ -184,12 +147,14 @@ typedef ^ ^ ReKi timeSer typedef ^ ^ IntKi iTimeSeries - - - "Stored index to optimize time interpolation" - typedef ^ ^ character(1024) root - - - "Output file rootname" "-" typedef ^ ^ Dvr_Outputs out - - - "data for driver output file" "-" +typedef ^ ^ ADI_IW_InputData IW_InitInp - - - "" - # ..... Data to wrap the driver .......................................................................................................... -typedef ^ AllData Dvr_SimData dvr - - - "" - -typedef ^ ^ AeroDyn_Data AD - - - "" - -typedef ^ ^ InflowWind_Data IW - - - "" - +typedef ^ AllData Dvr_SimData dvr - - - "Driver data" - +typedef ^ ^ ADI_Data ADI - - - "AeroDyn InflowWind Data" - +typedef ^ ^ FED_Data FED - - - "Elastic wind turbine data (Fake ElastoDyn)" "-" typedef ^ ^ IntKi errStat - - - "" - typedef ^ ^ character(ErrMsgLen) errMsg - - - "" - typedef ^ ^ logical initialized - - - "" - + diff --git a/modules/aerodyn/src/AeroDyn_Driver_Subs.f90 b/modules/aerodyn/src/AeroDyn_Driver_Subs.f90 index e6c51a5cc0..d65501bf88 100644 --- a/modules/aerodyn/src/AeroDyn_Driver_Subs.f90 +++ b/modules/aerodyn/src/AeroDyn_Driver_Subs.f90 @@ -19,6 +19,12 @@ ! !********************************************************************************************************************************** module AeroDyn_Driver_Subs + use AeroDyn_Inflow_Types + use AeroDyn_Inflow, only: ADI_Init, ADI_ReInit, ADI_End, ADI_CalcOutput, ADI_UpdateStates + use AeroDyn_Inflow, only: concatOutputHeaders + use AeroDyn_Inflow, only: ADI_ADIW_Solve ! TODO remove me + use AeroDyn_Inflow, only: Init_MeshMap_For_ADI, Set_Inputs_For_ADI + use AeroDyn_IO, only: AD_WrVTK_Surfaces, AD_WrVTK_LinesPoints use AeroDyn_Driver_Types use AeroDyn @@ -39,9 +45,10 @@ module AeroDyn_Driver_Subs integer(IntKi), parameter, dimension(3) :: idBaseMotionVALID = (/idBaseMotionFixed, idBaseMotionSine, idBaseMotionGeneral /) integer(IntKi), parameter :: idHubMotionConstant = 0 - integer(IntKi), parameter :: idHubMotionVariable = 1 - integer(IntKi), parameter :: idHubMotionStateTS = 2 !<<< Used internally, with idAnalysisTimeD - integer(IntKi), parameter, dimension(2) :: idHubMotionVALID = (/idHubMotionConstant, idHubMotionVariable/) + integer(IntKi), parameter :: idHubMotionVariable = 1 ! Input file with prescribed motion + integer(IntKi), parameter :: idHubMotionUserFunction = 3 ! User-defined function + integer(IntKi), parameter :: idHubMotionStateTS = 200 !<<< Used internally, with idAnalysisTimeD + integer(IntKi), parameter, dimension(3) :: idHubMotionVALID = (/idHubMotionConstant, idHubMotionVariable, idHubMotionUserFunction/) integer(IntKi), parameter :: idBldMotionConstant = 0 integer(IntKi), parameter :: idBldMotionVariable = 1 @@ -62,25 +69,41 @@ module AeroDyn_Driver_Subs integer(IntKi), parameter :: idAnalysisCombi = 3 integer(IntKi), parameter, dimension(3) :: idAnalysisVALID = (/idAnalysisRegular, idAnalysisTimeD, idAnalysisCombi/) - real(ReKi), parameter :: myNaN = -99.9_ReKi + ! User Swap Array - TODO not clean + integer(IntKi), parameter :: iAzi = 1 !< index in swap array for azimuth + integer(IntKi), parameter :: iN_ = 4 !< index in swap array for time step + integer(IntKi), parameter :: igenTorque = 5 !< index in swap array for generator torque + integer(IntKi), parameter :: igenTorqueF = 6 !< index in swap array for filtered generator torque + integer(IntKi), parameter :: irotTorque = 7 !< index in swap array for rotor torque + integer(IntKi), parameter :: irotTorqueF = 8 !< index in swap array for filtered rotor torque + integer(IntKi), parameter :: iDeltaTorque = 9 !< index in swap array for delta torque + integer(IntKi), parameter :: iDeltaTorqueF = 10 !< index in swap array for delta torque + integer(IntKi), parameter :: irotSpeedI = 11 !< index in swap array for instantaneous rotor speed + integer(IntKi), parameter :: irotSpeedF = 12 !< index in swap array for filtered rotor speed + integer(IntKi), parameter :: iAlpha = 13 !< index in swap array for filter constant alpha + integer(IntKi), parameter :: iRegion = 14 !< Controller region + + integer(IntKi), parameter :: NumInp = 2 + contains !---------------------------------------------------------------------------------------------------------------------------------- !> -subroutine Dvr_Init(dvr, AD, IW, errStat,errMsg ) - type(Dvr_SimData), intent( out) :: dvr ! driver data - type(AeroDyn_Data), intent( out) :: AD ! AeroDyn data - type(InflowWind_Data), intent( out) :: IW ! AeroDyn data - integer(IntKi) , intent( out) :: errStat ! Status of error message - character(*) , intent( out) :: errMsg ! Error message if ErrStat /= ErrID_None +subroutine Dvr_Init(dvr, ADI, FED, errStat, errMsg ) + type(Dvr_SimData), intent( out) :: dvr !< driver data + type(ADI_Data), intent( out) :: ADI !< AeroDyn/InflowWind data + type(FED_Data), intent( out) :: FED !< Elastic wind turbine data (Fake ElastoDyn) + integer(IntKi) , intent( out) :: errStat !< Status of error message + character(*) , intent( out) :: errMsg !< Error message if errStat /= ErrID_None ! local variables integer(IntKi) :: errStat2 ! local status of error message - character(ErrMsgLen) :: errMsg2 ! local error message if ErrStat /= ErrID_None - CHARACTER(1000) :: inputFile ! String to hold the file name. - CHARACTER(200) :: git_commit ! String containing the current git commit hash - CHARACTER(20) :: FlagArg ! flag argument from command line + character(ErrMsgLen) :: errMsg2 ! local error message if errStat /= ErrID_None + character(1000) :: inputFile ! String to hold the file name. + character(200) :: git_commit ! String containing the current git commit hash + character(20) :: FlagArg ! flag argument from command line + integer :: iWT ! Index on wind turbines/rotors errStat = ErrID_None errMsg = "" @@ -98,6 +121,14 @@ subroutine Dvr_Init(dvr, AD, IW, errStat,errMsg ) ! Read the AeroDyn driver input file call Dvr_ReadInputFile(inputFile, dvr, errStat2, errMsg2 ); if(Failed()) return + ! --- Propagate to FED + allocate(FED%WT(dvr%numTurbines), stat=errStat2); errMsg2='Allocating FED%WT'; if(Failed()) return + do iWT=1,dvr%numTurbines + FED%WT(iWT)%hasTower = dvr%WT(iWT)%hasTower + FED%WT(iWT)%numBlades = dvr%WT(iWT)%numBlades + FED%WT(iWT)%rigidBlades = .True. ! Driver only uses rigid blades + enddo + contains logical function Failed() @@ -109,18 +140,17 @@ end subroutine Dvr_Init !---------------------------------------------------------------------------------------------------------------------------------- !> -subroutine Dvr_InitCase(iCase, dvr, AD, IW, errStat, errMsg ) +subroutine Dvr_InitCase(iCase, dvr, ADI, FED, errStat, errMsg ) integer(IntKi) , intent(in ) :: iCase - type(Dvr_SimData), intent(inout) :: dvr ! driver data - type(AeroDyn_Data), intent(inout) :: AD ! AeroDyn data - type(InflowWind_Data), intent(inout) :: IW ! InflowWind data + type(Dvr_SimData), intent(inout) :: dvr !< driver data + type(ADI_Data), intent(inout) :: ADI !< AeroDyn/InflowWind data + type(FED_Data), intent(inout) :: FED !< Elastic wind turbine data (Fake ElastoDyn) integer(IntKi) , intent( out) :: errStat ! Status of error message - character(*) , intent( out) :: errMsg ! Error message if ErrStat /= ErrID_None + character(*) , intent( out) :: errMsg ! Error message if errStat /= ErrID_None ! local variables integer(IntKi) :: errStat2 ! local status of error message - character(ErrMsgLen) :: errMsg2 ! local error message if ErrStat /= ErrID_None + character(ErrMsgLen) :: errMsg2 ! local error message if errStat /= ErrID_None integer(IntKi) :: iWT, j !< - type(AD_InitOutputType) :: InitOutData_AD ! Output data from initialization errStat = ErrID_None errMsg = "" @@ -148,8 +178,10 @@ subroutine Dvr_InitCase(iCase, dvr, AD, IW, errStat, errMsg ) dvr%tMax = dvr%Cases(iCase)%tMax ! Set wind for this case - dvr%HWindSpeed = dvr%Cases(iCase)%HWindSpeed - dvr%PLexp = dvr%Cases(iCase)%PLExp + dvr%IW_InitInp%HWindSpeed = dvr%Cases(iCase)%HWindSpeed + dvr%IW_InitInp%PLexp = dvr%Cases(iCase)%PLExp + ADI%m%IW%HWindSpeed = dvr%Cases(iCase)%HWindSpeed ! We need to do it again since InFlow Wind is initialized only for iCase==1 + ADI%m%IW%PLexp = dvr%Cases(iCase)%PLExp ! Set motion for this case call setSimpleMotion(dvr%WT(1), dvr%Cases(iCase)%rotSpeed, dvr%Cases(iCase)%bldPitch, dvr%Cases(iCase)%nacYaw, dvr%Cases(iCase)%DOF, dvr%Cases(iCase)%amplitude, dvr%Cases(iCase)%frequency) @@ -174,106 +206,104 @@ subroutine Dvr_InitCase(iCase, dvr, AD, IW, errStat, errMsg ) ! --- Initialize meshes if (iCase==1) then - call Init_Meshes(dvr, errStat2, errMsg2); if(Failed()) return + call Init_Meshes(dvr, FED, errStat2, errMsg2); if(Failed()) return endif ! --- Initialize driver-only outputs if (allocated(dvr%out%storage)) deallocate(dvr%out%storage) if (iCase==1) then ! Initialize driver output channels, they are constant for all cases and all turbines! - call Dvr_InitializeDriverOutputs(dvr, errStat2, errMsg2); if(Failed()) return + call Dvr_InitializeDriverOutputs(dvr, ADI, errStat2, errMsg2); if(Failed()) return allocate(dvr%out%unOutFile(dvr%numTurbines)) endif dvr%out%unOutFile = -1 - ! --- Initialize aerodyn - call Init_AeroDyn(iCase, dvr, AD, dvr%dt, InitOutData_AD, errStat2, errMsg2); if(Failed()) return - - ! --- Initialize Inflow Wind - if (iCase==1) then - call Init_InflowWind(dvr, IW, AD%u(1), AD%OtherState, dvr%dt, errStat2, errMsg2); if(Failed()) return - endif + ! --- Initialize ADI + call Init_ADI_ForDriver(iCase, ADI, dvr, FED, dvr%dt, errStat2, errMsg2); if(Failed()) return ! --- Initialize meshes if (iCase==1) then - call Init_ADMeshMap(dvr, AD%u(1), errStat2, errMsg2); if(Failed()) return + call Init_MeshMap_For_ADI(FED, ADI%u(1)%AD, errStat2, errMsg2); if(Failed()) return endif ! Copy AD input here because tower is modified in ADMeshMap do j = 2, numInp - call AD_CopyInput (AD%u(1), AD%u(j), MESH_NEWCOPY, errStat2, errMsg2); if(Failed()) return + call AD_CopyInput (ADI%u(1)%AD, ADI%u(j)%AD, MESH_NEWCOPY, errStat2, errMsg2); if(Failed()) return end do - ! Compute driver outputs at t=0 - call Set_Mesh_Motion(0,dvr,errStat2,errMsg2); if(Failed()) return + call Set_Mesh_Motion(0, dvr, ADI, FED, errStat2, errMsg2); if(Failed()) return - ! --- Initial AD inputs - AD%inputTime = -999 + ! --- Initialze AD inputs + ADI%inputTimes = -999 ! TODO use something better? DO j = 1-numInp, 0 - call Set_AD_Inputs(j,dvr,AD,IW,errStat2,errMsg2); if(Failed()) return + call Shift_ADI_Inputs(j,dvr, ADI, errStat2, errMsg2); if(Failed()) return + call Set_Inputs_For_ADI(ADI%u(1), FED, errStat2, errMsg2); if(Failed()) return + call ADI_ADIW_Solve(ADI%inputTimes(1), ADI%u(1)%AD, ADI%OtherState%AD, ADI%m%IW%u, ADI%m%IW, .true., errStat2, errMsg2); if(Failed()) return ! TODO TODO TODO remove me END DO + ! --- AeroDyn + Inflow at T=0 + call ADI_CalcOutput(ADI%inputTimes(1), ADI%u(1), ADI%p, ADI%x, ADI%xd, ADI%z, ADI%OtherState, ADI%y, ADI%m, errStat2, errMsg2); if(Failed()) return ! --- Initialize outputs call Dvr_InitializeOutputs(dvr%numTurbines, dvr%out, dvr%numSteps, errStat2, errMsg2); if(Failed()) return - call Dvr_CalcOutputDriver(dvr, IW%y, errStat2, errMsg2); if(Failed()) return + call Dvr_CalcOutputDriver(dvr, ADI%y, FED, errStat2, errMsg2); if(Failed()) return ! --- Initialize VTK if (dvr%out%WrVTK>0) then dvr%out%n_VTKTime = 1 dvr%out%VTKRefPoint = (/0.0_SiKi, 0.0_SiKi, 0.0_SiKi /) - call SetVTKParameters(dvr%out, dvr, InitOutData_AD, AD, errStat2, errMsg2); if(Failed()) return + call SetVTKParameters(dvr%out, dvr, ADI, errStat2, errMsg2); if(Failed()) return endif call cleanUp() contains subroutine cleanUp() - call AD_DestroyInitOutput(InitOutData_AD, errStat2, errMsg2) end subroutine cleanUp logical function Failed() - CALL SetErrStat(errStat2, errMsg2, errStat, errMsg, 'Dvr_InitCase') + call SetErrStat(errStat2, errMsg2, errStat, errMsg, 'Dvr_InitCase') Failed = errStat >= AbortErrLev if(Failed) call cleanUp() end function Failed end subroutine Dvr_InitCase - - - +!---------------------------------------------------------------------------------------------------------------------------------- !> Perform one time step -subroutine Dvr_TimeStep(nt, dvr, AD, IW, errStat, errMsg) - integer(IntKi) , intent(in ) :: nt ! time step +subroutine Dvr_TimeStep(nt, dvr, ADI, FED, errStat, errMsg) + integer(IntKi) , intent(in ) :: nt ! next time step (current time is nt-1) type(Dvr_SimData), intent(inout) :: dvr ! driver data - type(AeroDyn_Data), intent(inout) :: AD ! AeroDyn data - type(InflowWind_Data), intent(inout) :: IW ! AeroDyn data + type(ADI_Data), intent(inout) :: ADI ! Input data for initialization (intent out for getting AD WriteOutput names/units) + type(FED_Data), intent(inout) :: FED ! Elastic wind turbine data (Fake ElastoDyn) integer(IntKi) , intent( out) :: errStat ! Status of error message - character(*) , intent( out) :: errMsg ! Error message if ErrStat /= ErrID_None + character(*) , intent( out) :: errMsg ! Error message if errStat /= ErrID_None ! local variables integer(IntKi) :: errStat2 ! local status of error message - character(ErrMsgLen) :: errMsg2 ! local error message if ErrStat /= ErrID_None + character(ErrMsgLen) :: errMsg2 ! local error message if errStat /= ErrID_None real(DbKi) :: time !< Variable for storing time, in seconds errStat = ErrID_None errMsg = '' - ! Update motion of meshes - call Set_Mesh_Motion(nt,dvr,errStat,errMsg) + ! Update motion of meshes for nt + call Set_Mesh_Motion(nt, dvr, ADI, FED, errStat,errMsg) ! Set AD inputs for nt (and keep values at nt-1 as well) - ! u(1) is at nt, u(2) is at nt-1 - call Set_AD_Inputs(nt,dvr,AD,IW,errStat2,errMsg2); if(Failed()) return - time = AD%inputTime(2) + ! u(1) is at nt, u(2) is at nt-1. Set inputs for nt timestep + call Shift_ADI_Inputs(nt,dvr, ADI, errStat2, errMsg2); if(Failed()) return + call Set_Inputs_For_ADI(ADI%u(1), FED, errStat2, errMsg2); if(Failed()) return + call ADI_ADIW_Solve(ADI%inputTimes(1), ADI%u(1)%AD, ADI%OtherState%AD, ADI%m%IW%u, ADI%m%IW, .true., errStat, errMsg) - ! Calculate outputs at nt - 1 - call AD_CalcOutput( time, AD%u(2), AD%p, AD%x, AD%xd, AD%z, AD%OtherState, AD%y, AD%m, errStat2, errMsg2 ); if(Failed()) return + time = ADI%inputTimes(2) + + ! Calculate outputs at nt - 1 (current time) + call ADI_CalcOutput(time, ADI%u(2), ADI%p, ADI%x, ADI%xd, ADI%z, ADI%OtherState, ADI%y, ADI%m, errStat2, errMsg2 ); if(Failed()) return ! Write outputs for all turbines at nt-1 - call Dvr_WriteOutputs(nt, time, dvr, dvr%out, AD%y, IW%y, errStat2, errMsg2); if(Failed()) return + call Dvr_WriteOutputs(nt, time, dvr, dvr%out, ADI%y, errStat2, errMsg2); if(Failed()) return ! We store the "driver-level" outputs only now, above, the old outputs are used - call Dvr_CalcOutputDriver(dvr, IW%y, errStat, errMsg) + call Dvr_CalcOutputDriver(dvr, ADI%y, FED, errStat, errMsg) ! VTK outputs @@ -281,36 +311,36 @@ subroutine Dvr_TimeStep(nt, dvr, AD, IW, errStat, errMsg) ! Init only select case (dvr%out%WrVTK_Type) case (1) ! surfaces - call WrVTK_Surfaces(time, dvr, dvr%out, nt-1, AD) - case (2) ! lines - call WrVTK_Lines( time, dvr, dvr%out, nt-1, AD) - case (3) ! both - call WrVTK_Surfaces(time, dvr, dvr%out, nt-1, AD) - call WrVTK_Lines( time, dvr, dvr%out, nt-1, AD) + call WrVTK_Surfaces(time, ADI, FED, dvr%out, nt-1) + case (2) ! lines + call WrVTK_Lines( time, ADI, FED, dvr%out, nt-1) + case (3) ! both + call WrVTK_Surfaces(time, ADI, FED, dvr%out, nt-1) + call WrVTK_Lines( time, ADI, FED, dvr%out, nt-1) end select endif ! Get state variables at next step: INPUT at step nt - 1, OUTPUT at step nt - call AD_UpdateStates( time, nt-1, AD%u, AD%inputTime, AD%p, AD%x, AD%xd, AD%z, AD%OtherState, AD%m, errStat2, errMsg2); if(Failed()) return + call ADI_UpdateStates( time, nt-1, ADI%u(:), ADI%inputTimes, ADI%p, ADI%x, ADI%xd, ADI%z, ADI%OtherState, ADI%m, errStat2, errMsg2); if(Failed()) return contains logical function Failed() - CALL SetErrStat(errStat2, errMsg2, errStat, errMsg, 'Dvr_TimeStep') + call SetErrStat(errStat2, errMsg2, errStat, errMsg, 'Dvr_TimeStep') Failed = errStat >= AbortErrLev end function Failed end subroutine Dvr_TimeStep -subroutine Dvr_EndCase(dvr, AD, IW, initialized, errStat, errMsg) +!---------------------------------------------------------------------------------------------------------------------------------- +subroutine Dvr_EndCase(dvr, ADI, initialized, errStat, errMsg) type(Dvr_SimData), intent(inout) :: dvr ! driver data - type(AeroDyn_Data), intent(inout) :: AD ! AeroDyn data - type(InflowWind_Data), intent(inout) :: IW ! AeroDyn data + type(ADI_Data), intent(inout) :: ADI ! Input data for initialization (intent out for getting AD WriteOutput names/units) logical, intent(inout) :: initialized ! integer(IntKi) , intent( out) :: errStat ! Status of error message - character(*) , intent( out) :: errMsg ! Error message if ErrStat /= ErrID_None + character(*) , intent( out) :: errMsg ! Error message if errStat /= ErrID_None ! local variables - character(ErrMsgLen) :: errMsg2 ! temporary Error message if ErrStat /= ErrID_None + character(ErrMsgLen) :: errMsg2 ! temporary Error message if errStat /= ErrID_None integer(IntKi) :: errStat2 ! temporary Error status of the operation integer(IntKi) :: iWT character(*), parameter :: RoutineName = 'Dvr_EndCase' @@ -341,16 +371,17 @@ subroutine Dvr_EndCase(dvr, AD, IW, initialized, errStat, errMsg) end subroutine Dvr_EndCase +!---------------------------------------------------------------------------------------------------------------------------------- !> End current case if not already closed, and destroy data -subroutine Dvr_CleanUp(dvr, AD, IW, initialized, errStat, errMsg) - type(Dvr_SimData), intent(inout) :: dvr ! driver data - type(AeroDyn_Data), intent(inout) :: AD ! AeroDyn data - type(InflowWind_Data), intent(inout) :: IW ! AeroDyn data +subroutine Dvr_CleanUp(dvr, ADI, FED, initialized, errStat, errMsg) + type(Dvr_SimData), intent(inout) :: dvr !< driver data + type(ADI_Data), intent(inout) :: ADI !< AeroDyn/InflowWind data + type(FED_Data), intent(inout) :: FED !< Elastic wind turbine data (Fake ElastoDyn) logical, intent(inout) :: initialized ! integer(IntKi) , intent( out) :: errStat ! Status of error message - character(*) , intent( out) :: errMsg ! Error message if ErrStat /= ErrID_None + character(*) , intent( out) :: errMsg ! Error message if errStat /= ErrID_None ! local variables - character(ErrMsgLen) :: errMsg2 ! temporary Error message if ErrStat /= ErrID_None + character(ErrMsgLen) :: errMsg2 ! temporary Error message if errStat /= ErrID_None integer(IntKi) :: errStat2 ! temporary Error status of the operation integer(IntKi) :: iWT character(*), parameter :: RoutineName = 'Dvr_CleanUp' @@ -358,39 +389,37 @@ subroutine Dvr_CleanUp(dvr, AD, IW, initialized, errStat, errMsg) errStat = ErrID_None errMsg = '' - call Dvr_EndCase(dvr, AD, IW, initialized, errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, RoutineName) + call Dvr_EndCase(dvr, ADI, initialized, errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, RoutineName) ! End modules - call AD_End( AD%u(1), AD%p, AD%x, AD%xd, AD%z, AD%OtherState, AD%y, AD%m, errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, RoutineName) - call InflowWind_End( IW%u(1), IW%p, IW%x, IW%xd, IW%z, IW%OtherSt, IW%y, IW%m, errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, RoutineName) - - call AD_Dvr_DestroyAeroDyn_Data (AD , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, RoutineName) - call AD_Dvr_DestroyInflowWind_Data(IW , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, RoutineName) + call ADI_End( ADI%u(:), ADI%p, ADI%x, ADI%xd, ADI%z, ADI%OtherState, ADI%y, ADI%m, errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, RoutineName); call AD_Dvr_DestroyDvr_SimData (dvr , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, RoutineName) -end subroutine Dvr_CleanUp + call ADI_DestroyFED_Data (FED , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, RoutineName) +end subroutine Dvr_CleanUp !---------------------------------------------------------------------------------------------------------------------------------- -!> Initialize aerodyn module based on driver data -subroutine Init_AeroDyn(iCase, dvr, AD, dt, InitOutData, errStat, errMsg) +subroutine Init_ADI_ForDriver(iCase, ADI, dvr, FED, dt, errStat, errMsg) integer(IntKi) , intent(in ) :: iCase - type(Dvr_SimData), target, intent(inout) :: dvr ! Input data for initialization (intent out for getting AD WriteOutput names/units) - type(AeroDyn_Data), intent(inout) :: AD ! AeroDyn data + type(ADI_Data), intent(inout) :: ADI ! Input data for initialization (intent out for getting AD WriteOutput names/units) + type(Dvr_SimData), target, intent(inout) :: dvr ! Input data for initialization (intent out for getting AD WriteOutput names/units) + type(FED_Data), target, intent(inout) :: FED ! Elastic wind turbine data (Fake ElastoDyn) real(DbKi), intent(inout) :: dt ! interval - type(AD_InitOutputType), intent( out) :: InitOutData ! Output data for initialization - integer(IntKi) , intent( out) :: errStat ! Status of error message - character(*) , intent( out) :: errMsg ! Error message if ErrStat /= ErrID_None + integer(IntKi) , intent(out) :: errStat ! Status of error message + character(*) , intent(out) :: errMsg ! Error message if errStat /= ErrID_None ! locals - real(reKi) :: theta(3) - integer(IntKi) :: j, k - integer(IntKi) :: iWT - integer(IntKi) :: errStat2 ! local status of error message - character(ErrMsgLen) :: errMsg2 ! local error message if ErrStat /= ErrID_None - type(AD_InitInputType) :: InitInData ! Input data for initialization - type(WTData), pointer :: wt ! Alias to shorten notation - logical :: needInit + real(reKi) :: theta(3) + integer(IntKi) :: j, k + integer(IntKi) :: iWT + integer(IntKi) :: errStat2 ! local status of error message + character(ErrMsgLen) :: errMsg2 ! local error message if errStat /= ErrID_None + type(WTData), pointer :: wt ! Alias to shorten notation + type(RotFED), pointer :: y_ED ! Alias to shorten notation + logical :: needInit + type(ADI_InitInputType) :: InitInp !< Input data for initialization routine (inout so we can use MOVE_ALLOC) + type(ADI_InitOutputType) :: InitOut !< Output for initialization routine errStat = ErrID_None errMsg = '' @@ -398,228 +427,106 @@ subroutine Init_AeroDyn(iCase, dvr, AD, dt, InitOutData, errStat, errMsg) if (iCase==1) then needInit=.True. else - ! UA does not like changes of dt - if ( .not. EqualRealNos(AD%p%DT, dt) ) then + ! UA does not like changes of dt between cases + if ( .not. EqualRealNos(ADI%p%AD%DT, dt) ) then call WrScr('Info: dt is changing between cases, AeroDyn will be re-initialized') - call AD_End( AD%u(1), AD%p, AD%x, AD%xd, AD%z, AD%OtherState, AD%y, AD%m, errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, 'Init_AeroDyn'); if(Failed()) return + call ADI_End( ADI%u(1:1), ADI%p, ADI%x, ADI%xd, ADI%z, ADI%OtherState, ADI%y, ADI%m, errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, 'Init_ADI_ForDriver'); if(Failed()) return !call AD_Dvr_DestroyAeroDyn_Data (AD , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, RoutineName) needInit=.true. endif endif if (needInit) then - ! --- Set init data - allocate(InitInData%rotors(dvr%numTurbines), stat=errStat) + ! ADI + InitInp%storeHHVel = .true. + InitInp%WrVTK = dvr%out%WrVTK + InitInp%WrVTK_Type = dvr%out%WrVTK_Type + ! Inflow Wind + InitInp%IW_InitInp%InputFile = dvr%IW_InitInp%InputFile + InitInp%IW_InitInp%CompInflow = dvr%IW_InitInp%CompInflow + InitInp%IW_InitInp%HWindSpeed = dvr%IW_InitInp%HWindSpeed + InitInp%IW_InitInp%RefHt = dvr%IW_InitInp%RefHt + InitInp%IW_InitInp%PLExp = dvr%IW_InitInp%PLExp + InitInp%IW_InitInp%UseInputFile = .true. ! read input file instead of passed file data + ! AeroDyn + InitInp%AD%Gravity = 9.80665_ReKi + InitInp%AD%RootName = dvr%out%Root ! 'C:/Work/XFlow/' + InitInp%AD%InputFile = dvr%AD_InputFile + InitInp%AD%MHK = dvr%MHK + InitInp%AD%defFldDens = dvr%FldDens + InitInp%AD%defKinVisc = dvr%KinVisc + InitInp%AD%defSpdSound = dvr%SpdSound + InitInp%AD%defPatm = dvr%Patm + InitInp%AD%defPvap = dvr%Pvap + InitInp%AD%WtrDpth = dvr%WtrDpth + InitInp%AD%MSL2SWL = dvr%MSL2SWL + ! Init data per rotor + allocate(InitInp%AD%rotors(dvr%numTurbines), stat=errStat) if (errStat/=0) then - call SetErrStat( ErrID_Fatal, 'Allocating rotors', errStat, errMsg, 'Init_AeroDyn' ) + call SetErrStat( ErrID_Fatal, 'Allocating rotors', errStat, errMsg, 'Init_ADI_ForDriver' ) call Cleanup() return end if - InitInData%InputFile = dvr%AD_InputFile - InitInData%RootName = dvr%out%Root - InitInData%Gravity = 9.80665_ReKi - InitInData%MHK = dvr%MHK - InitInData%defFldDens = dvr%FldDens - InitInData%defKinVisc = dvr%KinVisc - InitInData%defSpdSound = dvr%SpdSound - InitInData%defPatm = dvr%Patm - InitInData%defPvap = dvr%Pvap - InitInData%WtrDpth = dvr%WtrDpth - InitInData%MSL2SWL = dvr%MSL2SWL - ! Init data per rotor + ! --- TODO Make this block independent of driver do iWT=1,dvr%numTurbines wt => dvr%WT(iWT) - InitInData%rotors(iWT)%numBlades = wt%numBlades - call AllocAry(InitInData%rotors(iWT)%BladeRootPosition, 3, wt%numBlades, 'BladeRootPosition', errStat2, ErrMsg2 ); if (Failed()) return - call AllocAry(InitInData%rotors(iWT)%BladeRootOrientation, 3, 3, wt%numBlades, 'BladeRootOrientation', errStat2, ErrMsg2 ); if (Failed()) return + y_ED => FED%WT(iWT) + InitInp%AD%rotors(iWT)%numBlades = wt%numBlades + call AllocAry(InitInp%AD%rotors(iWT)%BladeRootPosition, 3, wt%numBlades, 'BladeRootPosition', errStat2, errMsg2 ); if (Failed()) return + call AllocAry(InitInp%AD%rotors(iWT)%BladeRootOrientation, 3, 3, wt%numBlades, 'BladeRootOrientation', errStat2, errMsg2 ); if (Failed()) return if (wt%projMod==-1)then - call WrScr('>>> Using HAWTprojection to determine projMod') + !call WrScr('>>> Using HAWTprojection to determine projMod') if (wt%HAWTprojection) then - InitInData%rotors(iWT)%AeroProjMod = APM_BEM_NoSweepPitchTwist ! default, with WithoutSweepPitchTwist + InitInp%AD%rotors(iWT)%AeroProjMod = APM_BEM_NoSweepPitchTwist ! default, with WithoutSweepPitchTwist else - InitInData%rotors(iWT)%AeroProjMod = APM_LiftingLine + InitInp%AD%rotors(iWT)%AeroProjMod = APM_LiftingLine endif else - InitInData%rotors(iWT)%AeroProjMod = wt%projMod + InitInp%AD%rotors(iWT)%AeroProjMod = wt%projMod endif - call WrScr('>>> Using projection method '//trim(num2lstr(InitInData%rotors(iWT)%AeroProjMod))) - InitInData%rotors(iWT)%HubPosition = wt%hub%ptMesh%Position(:,1) - InitInData%rotors(iWT)%HubOrientation = wt%hub%ptMesh%RefOrientation(:,:,1) - InitInData%rotors(iWT)%NacellePosition = wt%nac%ptMesh%Position(:,1) - InitInData%rotors(iWT)%NacelleOrientation = wt%nac%ptMesh%RefOrientation(:,:,1) + !call WrScr('>>> Using projection method '//trim(num2lstr(InitInp%AD%rotors(iWT)%AeroProjMod))) + InitInp%AD%rotors(iWT)%HubPosition = y_ED%HubPtMotion%Position(:,1) + InitInp%AD%rotors(iWT)%HubOrientation = y_ED%HubPtMotion%RefOrientation(:,:,1) + InitInp%AD%rotors(iWT)%NacellePosition = y_ED%NacelleMotion%Position(:,1) + InitInp%AD%rotors(iWT)%NacelleOrientation = y_ED%NacelleMotion%RefOrientation(:,:,1) do k=1,wt%numBlades - InitInData%rotors(iWT)%BladeRootOrientation(:,:,k) = wt%bld(k)%ptMesh%RefOrientation(:,:,1) - InitInData%rotors(iWT)%BladeRootPosition(:,k) = wt%bld(k)%ptMesh%Position(:,1) + InitInp%AD%rotors(iWT)%BladeRootOrientation(:,:,k) = y_ED%BladeRootMotion(k)%RefOrientation(:,:,1) + InitInp%AD%rotors(iWT)%BladeRootPosition(:,k) = y_ED%BladeRootMotion(k)%Position(:,1) end do enddo - ! --- Call AD_init - call AD_Init(InitInData, AD%u(1), AD%p, AD%x, AD%xd, AD%z, AD%OtherState, AD%y, AD%m, dt, InitOutData, ErrStat2, ErrMsg2 ); if (Failed()) return + call ADI_Init(InitInp, ADI%u(1), ADI%p, ADI%x, ADI%xd, ADI%z, ADI%OtherState, ADI%y, ADI%m, dt, InitOut, errStat, errMsg) + + ! Set output headers if (iCase==1) then - ! Add writeoutput units and headers to driver, same for all cases and rotors! - call concatOutputHeaders(dvr, InitOutData%rotors(1)%WriteOutputHdr, InitOutData%rotors(1)%WriteOutputUnt, errStat2, errMsg2); if(Failed()) return + call concatOutputHeaders(dvr%out%WriteOutputHdr, dvr%out%WriteOutputUnt, InitOut%WriteOutputHdr, InitOut%WriteOutputUnt, errStat2, errMsg2); if(Failed()) return endif - - dvr%out%AD_ver = InitOutData%ver - else ! --- Reinit - call AD_ReInit(AD%p, AD%x, AD%xd, AD%z, AD%OtherState, AD%m, dt, errStat2, errMsg2); if(Failed()) return + call ADI_ReInit(ADI%p, ADI%x, ADI%xd, ADI%z, ADI%OtherState, ADI%m, dt, errStat2, errMsg2); if(Failed()) return endif + call cleanup() contains subroutine cleanup() - call AD_DestroyInitInput (InitInData, errStat2, errMsg2) + call ADI_DestroyInitInput (InitInp, errStat2, errMsg2) + call ADI_DestroyInitOutput(InitOut, errStat2, errMsg2) end subroutine cleanup logical function Failed() - CALL SetErrStat(errStat2, errMsg2, errStat, errMsg, 'Init_AeroDyn') + call SetErrStat(errStat2, errMsg2, errStat, errMsg, 'Init_ADI_ForDriver') Failed = errStat >= AbortErrLev - if (Failed) then - call cleanup() - endif + if (Failed) call cleanup() end function Failed -end subroutine Init_AeroDyn - - -!---------------------------------------------------------------------------------------------------------------------------------- -!> -subroutine Init_InflowWind(dvr, IW, u_AD, o_AD, dt, errStat, errMsg) - use InflowWind, only: InflowWind_Init - type(Dvr_SimData), target, intent(inout) :: dvr ! Input data for initialization (intent out for getting AD WriteOutput names/units) - type(InflowWind_Data), intent(inout) :: IW ! AeroDyn data - type(AD_InputType), intent(in ) :: u_AD ! AeroDyn data - type(AD_OtherStateType), intent(in ) :: o_AD ! AeroDyn data - real(DbKi), intent(inout) :: dt ! interval - integer(IntKi) , intent( out) :: errStat ! Status of error message - character(*) , intent( out) :: errMsg ! Error message if ErrStat /= ErrID_None - ! locals - real(reKi) :: theta(3) - integer(IntKi) :: j, k, nOut_AD, nOut_IW, nOut_Dvr - integer(IntKi) :: iWT - integer(IntKi) :: errStat2 ! local status of error message - character(ErrMsgLen) :: errMsg2 ! local error message if ErrStat /= ErrID_None - type(InflowWind_InitInputType) :: InitInData ! Input data for initialization - type(InflowWind_InitOutputType) :: InitOutData ! Output data from initialization - type(WTData), pointer :: wt ! Alias to shorten notation - !character(ChanLen), allocatable :: WriteOutputHdr(:) - !character(ChanLen), allocatable :: WriteOutputUnt(:) - errStat = ErrID_None - errMsg = '' - - ! --- Count number of points (see FAST_Subs, before InflowWind_Init) - InitInData%NumWindPoints = 0 - ! Hub windspeed for each turbine - InitInData%NumWindPoints = InitInData%NumWindPoints + dvr%numTurbines - do iWT=1,dvr%numTurbines - wt => dvr%wt(iWT) - ! Blade - do k=1,wt%numBlades - InitInData%NumWindPoints = InitInData%NumWindPoints + u_AD%rotors(iWT)%BladeMotion(k)%NNodes - end do - ! Tower - InitInData%NumWindPoints = InitInData%NumWindPoints + u_AD%rotors(iWT)%TowerMotion%NNodes - ! Nacelle - if (u_AD%rotors(1)%NacelleMotion%Committed) then - InitInData%NumWindPoints = InitInData%NumWindPoints + u_AD%rotors(iWT)%NacelleMotion%NNodes ! 1 point - endif - ! Hub Motion - if (u_AD%rotors(1)%HubMotion%Committed) then - InitInData%NumWindPoints = InitInData%NumWindPoints + u_AD%rotors(iWT)%HubMotion%NNodes ! 1 point - endif - ! TailFin - InitInData%NumWindPoints = InitInData%NumWindPoints + u_AD%rotors(iWT)%TFinMotion%NNodes ! 1 point - enddo - if (allocated(o_AD%WakeLocationPoints)) then - InitInData%NumWindPoints = InitInData%NumWindPoints + size(o_AD%WakeLocationPoints,DIM=2) - end if - - ! --- Init InflowWind - if (dvr%CompInflow==0) then - ! Fake "InflowWind" init - allocate(InitOutData%WriteOutputHdr(0)) - allocate(InitOutData%WriteOutputUnt(0)) - allocate(IW%y%WriteOutput(0)) - call AllocAry(IW%u(1)%PositionXYZ, 3, InitInData%NumWindPoints, 'PositionXYZ', errStat2, errMsg2); if (Failed()) return - call AllocAry(IW%y%VelocityUVW , 3, InitInData%NumWindPoints, 'VelocityUVW', errStat2, errMsg2); if (Failed()) return - IW%u(1)%PositionXYZ = myNaN - IW%y%VelocityUVW = myNaN - else - ! Module init - InitInData%InputFileName = dvr%IW_InputFile - InitInData%Linearize = .false. - InitInData%UseInputFile = .true. - InitInData%RootName = dvr%out%Root - CALL InflowWind_Init( InitInData, IW%u(1), IW%p, & - IW%x, IW%xd, IW%z, IW%OtherSt, & - IW%y, IW%m, dt, InitOutData, errStat2, errMsg2 ) - if(Failed()) return - - endif - - call InflowWind_CopyInput (IW%u(1), IW%u(2), MESH_NEWCOPY, errStat2, errMsg2); if(Failed()) return - - ! --- Concatenate AD outputs to IW outputs - call concatOutputHeaders(dvr, InitOutData%WriteOutputHdr, InitOutData%WriteOutputUnt, errStat2, errMsg2); if(Failed()) return - - call cleanup() -contains - subroutine cleanup() - call InflowWind_DestroyInitInput( InitInData, ErrStat2, ErrMsg2 ) - call InflowWind_DestroyInitOutput( InitOutData, ErrStat2, ErrMsg2 ) - end subroutine cleanup - - logical function Failed() - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'Init_AeroDyn' ) - Failed = ErrStat >= AbortErrLev - if (Failed) then - call cleanup() - endif - end function Failed -end subroutine Init_InflowWind - -!> Concatenate new output channels info to the extisting ones in the driver -subroutine concatOutputHeaders(dvr, WriteOutputHdr, WriteOutputUnt, errStat, errMsg) - type(Dvr_SimData), target, intent(inout) :: dvr !< Input data for initialization (intent out for getting AD WriteOutput names/units) - character(ChanLen), dimension(:), allocatable, intent(inout) :: WriteOutputHdr !< Channel headers - character(ChanLen), dimension(:), allocatable, intent(inout) :: WriteOutputUnt !< Channel units - integer(IntKi) , intent( out) :: errStat !< Status of error message - character(*) , intent( out) :: errMsg !< Error message if ErrStat /= ErrID_None - ! Locals - character(ChanLen), allocatable :: TmpHdr(:) - character(ChanLen), allocatable :: TmpUnt(:) - integer :: nOld, nAdd - errStat = ErrID_None - errMsg = '' - - - if (.not.allocated(dvr%out%WriteOutputHdr)) then - call move_alloc(WriteOutputHdr, dvr%out%WriteOutputHdr) - call move_alloc(WriteOutputUnt, dvr%out%WriteOutputUnt) - else - nOld = size(dvr%out%WriteOutputHdr) - nAdd = size(WriteOutputHdr) - - call move_alloc(dvr%out%WriteOutputHdr, TmpHdr) - call move_alloc(dvr%out%WriteOutputUnt, TmpUnt) - - allocate(dvr%out%WriteOutputHdr(nOld+nAdd)) - allocate(dvr%out%WriteOutputUnt(nOld+nAdd)) - dvr%out%WriteOutputHdr(1:nOld) = TmpHdr - dvr%out%WriteOutputUnt(1:nOld) = TmpUnt - dvr%out%WriteOutputHdr(nOld+1:nOld+nAdd) = WriteOutputHdr - dvr%out%WriteOutputUnt(nOld+1:nOld+nAdd) = WriteOutputUnt - deallocate(TmpHdr) - deallocate(TmpUnt) - endif -end subroutine concatOutputHeaders +end subroutine Init_ADI_ForDriver !---------------------------------------------------------------------------------------------------------------------------------- !> -subroutine Init_Meshes(dvr, errStat, errMsg) +subroutine Init_Meshes(dvr, FED, errStat, errMsg) type(Dvr_SimData), target, intent(inout) :: dvr ! Input data for initialization (intent out for getting AD WriteOutput names/units) + type(FED_Data), target, intent(inout) :: FED ! Elastic wind turbine data (Fake ElastoDyn) integer(IntKi) , intent( out) :: errStat ! Status of error message character(*) , intent( out) :: errMsg ! Error message if ErrStat /= ErrID_None ! locals @@ -632,14 +539,16 @@ subroutine Init_Meshes(dvr, errStat, errMsg) real(R8Ki) :: R_gl2wt(3,3) integer(IntKi) :: iWT, iB integer(IntKi) :: errStat2 ! local status of error message - character(ErrMsgLen) :: errMsg2 ! local error message if ErrStat /= ErrID_None + character(ErrMsgLen) :: errMsg2 ! local error message if errStat /= ErrID_None type(WTData), pointer :: wt ! Alias to shorten notation + type(RotFED), pointer :: y_ED ! Alias to shorten notation errStat = ErrID_None errMsg = '' ! --- Create motion meshes do iWT=1,dvr%numTurbines wt => dvr%WT(iWT) + y_ED => FED%WT(iWT) ! WT base pos = wt%originInit ! We initialize to indentity at first @@ -648,27 +557,26 @@ subroutine Init_Meshes(dvr, errStat, errMsg) orientation = R_gl2wt !bjj: Inspector consistently gives "Invalid Memory Access" errors here on the allocation of wt%ptMesh%RotationVel in MeshCreate. I haven't yet figured out why. - call CreatePointMesh(wt%ptMesh, pos, orientation, errStat2, errMsg2, hasMotion=.True., hasLoads=.False.); if(Failed()) return + call CreatePointMesh(y_ED%PlatformPtMesh, pos, orientation, errStat2, errMsg2, hasMotion=.True., hasLoads=.False.); if(Failed()) return ! Tower if (wt%hasTower) then - pos = wt%ptMesh%Position(:,1) + matmul(transpose(R_gl2wt), wt%twr%origin_t) + pos = y_ED%PlatformPtMesh%Position(:,1) + matmul(transpose(R_gl2wt), wt%twr%origin_t) orientation = R_gl2wt - call CreatePointMesh(wt%twr%ptMesh, pos, orientation, errStat2, errMsg2, hasMotion=.True., hasLoads=.False.); if(Failed()) return + call CreatePointMesh(y_ED%TwrPtMesh, pos, orientation, errStat2, errMsg2, hasMotion=.True., hasLoads=.False.); if(Failed()) return endif ! Nacelle - pos = wt%ptMesh%Position(:,1) + matmul(transpose(R_gl2wt), wt%nac%origin_t) + pos = y_ED%PlatformPtMesh%Position(:,1) + matmul(transpose(R_gl2wt), wt%nac%origin_t) orientation = R_gl2wt ! Yaw? - call CreatePointMesh(wt%nac%ptMesh, pos, orientation, errStat2, errMsg2, hasMotion=.True., hasLoads=.False.); if(Failed()) return + call CreatePointMesh(y_ED%NacelleMotion, pos, orientation, errStat2, errMsg2, hasMotion=.True., hasLoads=.False.); if(Failed()) return ! Hub - R_nac2gl = transpose(wt%nac%ptMesh%RefOrientation(:,:,1)) + R_nac2gl = transpose(y_ED%NacelleMotion%RefOrientation(:,:,1)) R_nac2hub = EulerConstruct( wt%hub%orientation_n ) ! nacelle 2 hub (constant) - pos = wt%nac%ptMesh%Position(:,1) + matmul(R_nac2gl,wt%hub%origin_n) - orientation = matmul(R_nac2hub, wt%nac%ptMesh%RefOrientation(:,:,1)) ! Global 2 hub at t=0 - - call CreatePointMesh(wt%hub%ptMesh, pos, orientation, errStat2, errMsg2, hasMotion=.True., hasLoads=.False.); if(Failed())return + pos = y_ED%NacelleMotion%Position(:,1) + matmul(R_nac2gl,wt%hub%origin_n) + orientation = matmul(R_nac2hub, y_ED%NacelleMotion%RefOrientation(:,:,1)) ! Global 2 hub at t=0 + call CreatePointMesh(y_ED%HubPtMotion, pos, orientation, errStat2, errMsg2, hasMotion=.True., hasLoads=.False.); if(Failed())return ! Blades ! wt%Rg2b0 = EulerConstruct( wt%orientationInit ) ! global 2 base at t = 0 (constant) @@ -676,39 +584,40 @@ subroutine Init_Meshes(dvr, errStat, errMsg) ! InitInData%HubPosition = wt%originInit + wt%nac%origin_t + matmul( transpose(wt%Rg2b0), wt%hub%origin_n) ! InitInData%HubOrientation = matmul(wt%Rb2h0, wt%Rg2b0) ! Global 2 hub = base2hub x global2base - R_hub2gl = transpose(wt%hub%ptMesh%RefOrientation(:,:,1)) + R_hub2gl = transpose(y_ED%HubPtMotion%RefOrientation(:,:,1)) + allocate(y_ED%BladeRootMotion(wt%numBlades)) do iB=1,wt%numBlades R_hub2bl = EulerConstruct( wt%bld(iB)%orientation_h ) ! Rotation matrix hub 2 blade (constant) - orientation = matmul(R_hub2bl, wt%hub%ptMesh%RefOrientation(:,:,1) ) ! Global 2 blade = hub2blade x global2hub - pos = wt%hub%ptMesh%Position(:,1) + matmul(R_hub2gl, wt%bld(iB)%origin_h) + wt%bld(iB)%hubRad_bl*orientation(3,:) - call CreatePointMesh(wt%bld(iB)%ptMesh, pos, orientation, errStat2, errMsg2, hasMotion=.True., hasLoads=.False.); if(Failed())return + orientation = matmul(R_hub2bl, y_ED%HubPtMotion%RefOrientation(:,:,1) ) ! Global 2 blade = hub2blade x global2hub + pos = y_ED%HubPtMotion%Position(:,1) + matmul(R_hub2gl, wt%bld(iB)%origin_h) + wt%bld(iB)%hubRad_bl*orientation(3,:) + call CreatePointMesh(y_ED%BladeRootMotion(iB), pos, orientation, errStat2, errMsg2, hasMotion=.True., hasLoads=.False.); if(Failed())return end do ! --- Mapping ! Base 2 twr if (wt%hasTower) then - call MeshMapCreate(wt%ptMesh, wt%twr%ptMesh, wt%map2twrPt, errStat2, errMsg2); if(Failed())return + call MeshMapCreate(y_ED%PlatformPtMesh, y_ED%TwrPtMesh, wt%map2twrPt, errStat2, errMsg2); if(Failed())return endif ! Base 2 nac - call MeshMapCreate(wt%ptMesh, wt%nac%ptMesh, wt%map2nacPt, errStat2, errMsg2); if(Failed())return + call MeshMapCreate(y_ED%PlatformPtMesh, y_ED%NacelleMotion, wt%map2nacPt, errStat2, errMsg2); if(Failed())return ! nac 2 hub - call MeshMapCreate(wt%nac%ptMesh, wt%hub%ptMesh, wt%nac%map2hubPt, errStat2, errMsg2); if(Failed())return + call MeshMapCreate(y_ED%NacelleMotion, y_ED%HubPtMotion, wt%map2hubPt, errStat2, errMsg2); if(Failed())return ! hub 2 bld - allocate(wt%hub%map2bldPt(wt%numBlades)) + allocate(wt%map2bldPt(wt%numBlades)) do iB=1,wt%numBlades - call MeshMapCreate(wt%hub%ptMesh, wt%bld(iB)%ptMesh, wt%hub%map2bldPt(iB), errStat2, errMsg2); if(Failed())return + call MeshMapCreate(y_ED%HubPtMotion, y_ED%BladeRootMotion(iB), wt%map2bldPt(iB), errStat2, errMsg2); if(Failed())return enddo ! ! --- NOTE: KEEP ME, this information would go well in a summary file... print*,'Nodes positions for turbine '//trim(num2lstr(iWT))//', (at t=0, without base or RNA motion)' - print*,'Bse: ',wt%ptMesh%Position + wt%ptMesh%TranslationDisp + print*,'Bse: ',y_ED%PlatformPtMesh%Position + y_ED%PlatformPtMesh%TranslationDisp if (wt%hasTower) then - print*,'Twr: ',wt%twr%ptMesh%Position + wt%twr%ptMesh%TranslationDisp + print*,'Twr: ',y_ED%TwrPtMesh%Position + y_ED%TwrPtMesh%TranslationDisp endif - print*,'Nac: ',wt%nac%ptMesh%Position + wt%nac%ptMesh%TranslationDisp - print*,'Hub: ',wt%hub%ptMesh%Position + wt%hub%ptMesh%TranslationDisp + print*,'Nac: ',y_ED%NacelleMotion%Position + y_ED%NacelleMotion%TranslationDisp + print*,'Hub: ',y_ED%HubPtMotion%Position + y_ED%HubPtMotion%TranslationDisp do iB=1,wt%numBlades - print*,'Bld: ',wt%bld(iB)%ptMesh%Position + wt%bld(iB)%ptMesh%TranslationDisp + print*,'Bld: ',y_ED%BladeRootMotion(iB)%Position + y_ED%BladeRootMotion(iB)%TranslationDisp enddo enddo @@ -716,118 +625,27 @@ subroutine Init_Meshes(dvr, errStat, errMsg) logical function Failed() call SetErrStat(errStat2, errMsg2, errStat, errMsg, 'Init_Meshes') - Failed = ErrStat >= AbortErrLev + Failed = errStat >= AbortErrLev end function Failed end subroutine Init_Meshes -!> Initialize the mesh mappings between the structure and aerodyn -!! Also adjust the tower mesh so that is is aligned with the tower base and tower top -subroutine Init_ADMeshMap(dvr, uAD, errStat, errMsg) - type(Dvr_SimData), target, intent(inout) :: dvr ! Input data for initialization (intent out for getting AD WriteOutput names/units) - type(AD_InputType), intent(inout) :: uAD ! AeroDyn input data - integer(IntKi) , intent( out) :: errStat ! Status of error message - character(*) , intent( out) :: errMsg ! Error message if ErrStat /= ErrID_None - ! locals - real(ReKi) :: pos(3), Pbase(3), Ptop(3), Pmid(3), DeltaP(3) - real(R8Ki) :: orientation(3,3) - real(ReKi) :: twrHeightAD , twrHeight - real(ReKi) :: zBar ! dimensionsless tower height - integer(IntKi) :: iWT, iB, i - integer(IntKi) :: errStat2 ! local status of error message - character(ErrMsgLen) :: errMsg2 ! local error message if ErrStat /= ErrID_None - type(WTData), pointer :: wt ! Alias to shorten notation - errStat = ErrID_None - errMsg = '' - - ! --- Create Mappings from structure to AeroDyn - do iWT=1,dvr%numTurbines - wt => dvr%WT(iWT) - ! hub 2 hubAD - call MeshMapCreate(wt%hub%ptMesh, uAD%rotors(iWT)%hubMotion, wt%hub%ED_P_2_AD_P_H, errStat2, errMsg2); if(Failed())return - - ! nac 2 nacAD - call MeshMapCreate(wt%nac%ptMesh, uAD%rotors(iWT)%nacelleMotion, wt%nac%ED_P_2_AD_P_N, errStat2, errMsg2); if(Failed())return - - ! bldroot 2 bldroot AD - do iB = 1, wt%numBlades - call MeshMapCreate(wt%bld(iB)%ptMesh, uAD%rotors(iWT)%BladeRootMotion(iB), wt%bld(iB)%ED_P_2_AD_P_R, errStat2, errMsg2); if(Failed())return - enddo - - ! AD bld root 2 AD blade line - do iB = 1, wt%numBlades - call MeshMapCreate(uAD%rotors(iWT)%BladeRootMotion(iB), uAD%rotors(iWT)%BladeMotion(iB), wt%bld(iB)%AD_P_2_AD_L_B, errStat2, errMsg2); if(Failed())return - enddo - - if (uAD%rotors(iWT)%TowerMotion%nNodes>0) then - if (wt%hasTower) then - twrHeightAD=uAD%rotors(iWT)%TowerMotion%Position(3,uAD%rotors(iWT)%TowerMotion%nNodes)-uAD%rotors(iWT)%TowerMotion%Position(3,1) - ! Check tower height - if (twrHeightAD<0) then - errStat=ErrID_Fatal - errMsg='First AeroDyn tower height should be smaller than last AD tower height' - endif - - twrHeightAD=uAD%rotors(iWT)%TowerMotion%Position(3,uAD%rotors(iWT)%TowerMotion%nNodes) ! NOTE: assuming start a z=0 - - twrHeight=TwoNorm(wt%nac%ptMesh%Position(:,1) - wt%twr%ptMesh%Position(:,1) ) - ! KEEP ME, in summary file - !print*,'Tower Height',twrHeight, twrHeightAD - if (abs(twrHeightAD-twrHeight)> twrHeight*0.1) then - errStat=ErrID_Fatal - errMsg='More than 10% difference between AeroDyn tower length ('//trim(num2lstr(twrHeightAD))//& - 'm), and the distance from tower base to nacelle ('//trim(num2lstr(twrHeight))//'m) for turbine '//trim(num2lstr(iWT)) - endif - - ! Adjust tower position (AeroDyn return values assuming (0,0,0) for tower base - Pbase = wt%twr%ptMesh%Position(:,1) - Ptop = wt%nac%ptMesh%Position(:,1) - DeltaP = Ptop-Pbase - do i = 1, uAD%rotors(iWT)%TowerMotion%nNodes - zBar = uAD%rotors(iWT)%TowerMotion%Position(3,i)/twrHeight - uAD%rotors(iWT)%TowerMotion%Position(:,i)= Pbase+ zBar * DeltaP - uAD%rotors(iWT)%TowerMotion%RefOrientation(:,:,i)= wt%twr%ptMesh%RefOrientation(:,:,1) - enddo - ! Create AD tower base point mesh - pos = wt%twr%ptMesh%Position(:,1) - orientation = wt%twr%ptMesh%RefOrientation(:,:,1) - call Eye(orientation, errStat2, errMsg2) - call CreatePointMesh(wt%twr%ptMeshAD, pos, orientation, errStat2, errMsg2, hasMotion=.True., hasLoads=.False.); if(Failed())return - - ! TowerBase to AD tower base - call MeshMapCreate(wt%twr%ptMesh, wt%twr%ptMeshAD, wt%twr%ED_P_2_AD_P_T, errStat2, errMsg2); if(Failed()) return - - ! AD TowerBase to AD tower line - call MeshMapCreate(wt%twr%ptMeshAD, uAD%rotors(iWT)%TowerMotion, wt%twr%AD_P_2_AD_L_T, errStat2, errMsg2); if(Failed()) return - endif - else - print*,'>>> NO AD Tower' - ! TODO create a tower mesh for outputs - endif - - enddo - -contains - - logical function Failed() - call SetErrStat(errStat2, errMsg2, errStat, errMsg, 'Init_ADMeshMap') - Failed = ErrStat >= AbortErrLev - end function Failed -end subroutine Init_ADMeshMap !---------------------------------------------------------------------------------------------------------------------------------- !> Set the motion of the different structural meshes !! "ED_CalcOutput" -subroutine Set_Mesh_Motion(nt,dvr,errStat,errMsg) +subroutine Set_Mesh_Motion(nt, dvr, ADI, FED, errStat, errMsg) integer(IntKi) , intent(in ) :: nt !< time step number - type(Dvr_SimData), target, intent(inout) :: dvr !< Driver data + type(Dvr_SimData), target, intent(inout) :: dvr !< Driver data + type(ADI_Data), intent(inout) :: ADI !< AeroDyn/InflowWind Data + type(FED_Data), target, intent(inout) :: FED !< Elastic wind turbine data (Fake ElastoDyn) integer(IntKi) , intent( out) :: errStat !< Status of error message - character(*) , intent( out) :: errMsg !< Error message if ErrStat /= ErrID_None + character(*) , intent( out) :: errMsg !< Error message if errStat /= ErrID_None ! local variables integer(intKi) :: j ! loop counter for nodes integer(intKi) :: k ! loop counter for blades integer(intKi) :: iWT ! loop counter for rotors integer(intKi) :: iB ! loop counter for blades integer(IntKi) :: errStat2 ! local status of error message - character(ErrMsgLen) :: errMsg2 ! local error message if ErrStat /= ErrID_None + character(ErrMsgLen) :: errMsg2 ! local error message if errStat /= ErrID_None real(R8Ki) :: theta(3) real(ReKi) :: hubMotion(3) ! Azimuth, Speed, Acceleration real(ReKi) :: nacMotion(3) ! Yaw, yaw speed, yaw acc @@ -839,6 +657,7 @@ subroutine Set_Mesh_Motion(nt,dvr,errStat,errMsg) real(R8Ki) :: orientation_loc(3,3) real(DbKi) :: time, timePrev type(WTData), pointer :: wt ! Alias to shorten notation + type(RotFED), pointer :: y_ED ! Alias to shorten notation errStat = ErrID_None errMsg = "" @@ -850,8 +669,8 @@ subroutine Set_Mesh_Motion(nt,dvr,errStat,errMsg) ! timestate = HWindSpeed, PLExp, RotSpeed, Pitch, yaw call interpTimeValue(dvr%timeSeries, time, dvr%iTimeSeries, timeState) ! Set wind at this time - dvr%HWindSpeed = timeState(1) - dvr%PLexp = timeState(2) + ADI%m%IW%HWindSpeed = timeState(1) + ADI%m%IW%PLexp = timeState(2) !! Set motion at this time dvr%WT(1)%hub%rotSpeed = timeState(3) ! rad/s do j=1,size(dvr%WT(1)%bld) @@ -873,45 +692,46 @@ subroutine Set_Mesh_Motion(nt,dvr,errStat,errMsg) ! --- Update motion do iWT=1,dvr%numTurbines wt => dvr%WT(iWT) + y_ED => FED%WT(iWT) ! --- Base Motion orientation = EulerConstruct( wt%orientationInit ) ! global 2 base at t = 0 (constant) if (wt%motionType == idBaseMotionGeneral) then orientation_loc = EulerConstruct( theta ) call interpTimeValue(wt%motion, time, wt%iMotion, basMotion) - wt%ptMesh%TranslationDisp(1:3,1) = basMotion(1:3) - wt%ptMesh%TranslationVel (1:3,1) = basMotion(7:9) - wt%ptMesh%RotationVel (1:3,1) = basMotion(10:12) - wt%ptMesh%TranslationAcc (1:3,1) = basMotion(13:15) - wt%ptMesh%RotationAcc (1:3,1) = basMotion(16:18) + y_ED%PlatformPtMesh%TranslationDisp(1:3,1) = basMotion(1:3) + y_ED%PlatformPtMesh%TranslationVel (1:3,1) = basMotion(7:9) + y_ED%PlatformPtMesh%RotationVel (1:3,1) = basMotion(10:12) + y_ED%PlatformPtMesh%TranslationAcc (1:3,1) = basMotion(13:15) + y_ED%PlatformPtMesh%RotationAcc (1:3,1) = basMotion(16:18) theta = basMotion(4:6) orientation_loc = EulerConstruct( theta ) orientation = matmul(orientation_loc, orientation) elseif (wt%motionType == idBaseMotionSine) then if (any(wt%degreeOfFreedom==(/1,2,3/))) then - wt%ptMesh%TranslationDisp(wt%degreeofFreedom,1) = wt%amplitude * sin(time * wt%frequency) - wt%ptMesh%TranslationVel (wt%degreeofFreedom,1) = (wt%frequency) * wt%amplitude * cos(time * wt%frequency) - wt%ptMesh%TranslationAcc (wt%degreeofFreedom,1) = -(wt%frequency)**2 * wt%amplitude * sin(time * wt%frequency) + y_ED%PlatformPtMesh%TranslationDisp(wt%degreeofFreedom,1) = wt%amplitude * sin(time * wt%frequency) + y_ED%PlatformPtMesh%TranslationVel (wt%degreeofFreedom,1) = (wt%frequency) * wt%amplitude * cos(time * wt%frequency) + y_ED%PlatformPtMesh%TranslationAcc (wt%degreeofFreedom,1) = -(wt%frequency)**2 * wt%amplitude * sin(time * wt%frequency) elseif (any(wt%degreeOfFreedom==(/4,5,6/))) then theta(1:3) = 0.0_ReKi theta(wt%degreeofFreedom-3) = wt%amplitude * sin(time * wt%frequency) - wt%ptMesh%RotationVel (wt%degreeofFreedom-3,1) = (wt%frequency) * wt%amplitude * cos(time * wt%frequency) - wt%ptMesh%RotationAcc (wt%degreeofFreedom-3,1) = -(wt%frequency)**2 * wt%amplitude * sin(time * wt%frequency) + y_ED%PlatformPtMesh%RotationVel (wt%degreeofFreedom-3,1) = (wt%frequency) * wt%amplitude * cos(time * wt%frequency) + y_ED%PlatformPtMesh%RotationAcc (wt%degreeofFreedom-3,1) = -(wt%frequency)**2 * wt%amplitude * sin(time * wt%frequency) orientation_loc = EulerConstruct( theta ) orientation = matmul(orientation_loc, orientation) endif endif - wt%ptMesh%Orientation(:,:,1) = orientation + y_ED%PlatformPtMesh%Orientation(:,:,1) = orientation ! --- Tower motion (none) ! Base to Tower if (wt%hasTower) then - call Transfer_Point_to_Point(wt%ptMesh, wt%twr%ptMesh, wt%map2twrPt, errStat2, errMsg2); if(Failed()) return + call Transfer_Point_to_Point(y_ED%PlatformPtMesh, y_ED%TwrPtMesh, wt%map2twrPt, errStat2, errMsg2); if(Failed()) return endif ! --- Nacelle Motion ! Base to Nac - call Transfer_Point_to_Point(wt%ptMesh, wt%nac%ptMesh, wt%map2nacPt, errStat2, errMsg2); if(Failed()) return + call Transfer_Point_to_Point(y_ED%PlatformPtMesh, y_ED%NacelleMotion, wt%map2nacPt, errStat2, errMsg2); if(Failed()) return ! Nacelle yaw motion (along nac z) theta =0.0_ReKi if (wt%nac%motionType==idNacMotionConstant) then @@ -923,19 +743,19 @@ subroutine Set_Mesh_Motion(nt,dvr,errStat,errMsg) wt%nac%yawSpeed = nacMotion(2) wt%nac%yawAcc = nacMotion(3) else - ErrMsg2='Unknown nac motion type; should never happen.' - ErrStat2 = ErrID_FATAL + errMsg2='Unknown nac motion type; should never happen.' + errStat2 = ErrID_FATAL if(Failed()) return endif theta(3) = wt%nac%yaw orientation_loc = EulerConstruct(theta) - wt%nac%ptMesh%Orientation(:,:,1) = matmul(orientation_loc, wt%nac%ptMesh%Orientation(:,:,1)) - wt%nac%ptMesh%RotationVel( :,1) = wt%nac%ptMesh%RotationVel(:,1) + wt%nac%ptMesh%Orientation(3,:,1) * wt%nac%yawSpeed - wt%nac%ptMesh%RotationAcc( :,1) = wt%nac%ptMesh%RotationAcc(:,1) + wt%nac%ptMesh%Orientation(3,:,1) * wt%nac%yawAcc + y_ED%NacelleMotion%Orientation(:,:,1) = matmul(orientation_loc, y_ED%NacelleMotion%Orientation(:,:,1)) + y_ED%NacelleMotion%RotationVel( :,1) = y_ED%NacelleMotion%RotationVel(:,1) + y_ED%NacelleMotion%Orientation(3,:,1) * wt%nac%yawSpeed + y_ED%NacelleMotion%RotationAcc( :,1) = y_ED%NacelleMotion%RotationAcc(:,1) + y_ED%NacelleMotion%Orientation(3,:,1) * wt%nac%yawAcc ! --- Hub Motion ! Nac 2 hub (rigid body) - call Transfer_Point_to_Point(wt%nac%ptMesh, wt%hub%ptMesh, wt%nac%map2hubPt, errStat2, errMsg2); if(Failed()) return + call Transfer_Point_to_Point(y_ED%NacelleMotion, y_ED%HubPtMotion, wt%map2hubPt, errStat2, errMsg2); if(Failed()) return ! Hub rotation around x if (wt%hub%motionType == idHubMotionConstant) then ! save the azimuth at t (not t+dt) for output to file: @@ -954,6 +774,10 @@ subroutine Set_Mesh_Motion(nt,dvr,errStat,errMsg) wt%hub%rotSpeed = hubMotion(2) wt%hub%rotAcc = hubMotion(2) wt%hub%azimuth = MODULO(hubMotion(1)*R2D, 360.0_ReKi ) + else if (wt%hub%motionType == idHubMotionUserFunction) then + ! We call a user-defined function to determined the azimuth, speed (and potentially acceleration...) + call userHubMotion(nt, iWT, dvr, ADI, FED, wt%userSwapArray, wt%hub%azimuth, wt%hub%rotSpeed, wt%hub%rotAcc, errStat2, errMsg2) + if (Failed()) return else if (wt%hub%motionType == idHubMotionStateTS) then ! NOTE: match AeroDyndriver for backward compatibility @@ -974,14 +798,14 @@ subroutine Set_Mesh_Motion(nt,dvr,errStat,errMsg) theta(2) = 0.0_ReKi theta(3) = 0.0_ReKi orientation_loc = EulerConstruct( theta ) - wt%hub%ptMesh%Orientation(:,:,1) = matmul(orientation_loc, wt%hub%ptMesh%Orientation(:,:,1)) - wt%hub%ptMesh%RotationVel( :,1) = wt%hub%ptMesh%RotationVel(:,1) + wt%hub%ptMesh%Orientation(1,:,1) * wt%hub%rotSpeed - wt%hub%ptMesh%RotationAcc( :,1) = wt%hub%ptMesh%RotationAcc(:,1) + wt%hub%ptMesh%Orientation(1,:,1) * wt%hub%rotAcc + y_ED%HubPtMotion%Orientation(:,:,1) = matmul(orientation_loc, y_ED%HubPtMotion%Orientation(:,:,1)) + y_ED%HubPtMotion%RotationVel( :,1) = y_ED%HubPtMotion%RotationVel(:,1) + y_ED%HubPtMotion%Orientation(1,:,1) * wt%hub%rotSpeed + y_ED%HubPtMotion%RotationAcc( :,1) = y_ED%HubPtMotion%RotationAcc(:,1) + y_ED%HubPtMotion%Orientation(1,:,1) * wt%hub%rotAcc ! --- Blade motion ! Hub 2 blade root do iB = 1,wt%numBlades - call Transfer_Point_to_Point(wt%hub%ptMesh, wt%bld(iB)%ptMesh, wt%hub%map2bldPt(iB), errStat2, errMsg2); if(Failed()) return + call Transfer_Point_to_Point(y_ED%HubPtMotion, y_ED%BladeRootMotion(iB), wt%map2bldPt(iB), errStat2, errMsg2); if(Failed()) return ! Pitch motion aong z theta =0.0_ReKi if (wt%bld(iB)%motionType==idBldMotionConstant) then @@ -989,256 +813,59 @@ subroutine Set_Mesh_Motion(nt,dvr,errStat,errMsg) elseif (wt%bld(iB)%motionType==idBldMotionVariable) then call interpTimeValue(wt%bld(iB)%motion, time, wt%bld(iB)%iMotion, bldMotion) wt%bld(iB)%pitch =bldMotion(1) - wt%bld(iB)%ptMesh%RotationVel(:,1) = wt%bld(iB)%ptMesh%RotationVel(:,1) + wt%bld(iB)%ptMesh%Orientation(3,:,1)* (-bldMotion(2)) - wt%bld(iB)%ptMesh%RotationAcc(:,1) = wt%bld(iB)%ptMesh%RotationAcc(:,1) + wt%bld(iB)%ptMesh%Orientation(3,:,1)* (-bldMotion(3)) + y_ED%BladeRootMotion(iB)%RotationVel(:,1) = y_ED%BladeRootMotion(iB)%RotationVel(:,1) + y_ED%BladeRootMotion(iB)%Orientation(3,:,1)* (-bldMotion(2)) + y_ED%BladeRootMotion(iB)%RotationAcc(:,1) = y_ED%BladeRootMotion(iB)%RotationAcc(:,1) + y_ED%BladeRootMotion(iB)%Orientation(3,:,1)* (-bldMotion(3)) else print*,'Unknown blade motion type, should never happen' STOP endif theta(3) = - wt%bld(iB)%pitch ! NOTE: sign, wind turbine convention ... orientation_loc = EulerConstruct(theta) - wt%bld(iB)%ptMesh%Orientation(:,:,1) = matmul(orientation_loc, wt%bld(iB)%ptMesh%Orientation(:,:,1)) + y_ED%BladeRootMotion(iB)%Orientation(:,:,1) = matmul(orientation_loc, y_ED%BladeRootMotion(iB)%Orientation(:,:,1)) enddo - !print*,'Bse: ',wt%ptMesh%Position + wt%ptMesh%TranslationDisp + !print*,'Bse: ',y_ED%PlatformPtMesh%Position + y_ED%PlatformPtMesh%TranslationDisp !if (wt%hasTower) then ! print*,'Twr: ',wt%twr%ptMesh%Position + wt%twr%ptMesh%TranslationDisp !endif !print*,'Nac: ',wt%nac%ptMesh%Position + wt%nac%ptMesh%TranslationDisp !print*,'Hub: ',wt%hub%ptMesh%Position + wt%hub%ptMesh%TranslationDisp !do iB=1,wt%numBlades - ! print*,'Bld: ',wt%bld(iB)%ptMesh%Position + wt%bld(iB)%ptMesh%TranslationDisp + ! print*,'Bld: ',y_ED%BladeRootMotion(iB)%Position + y_ED%BladeRootMotion(iB)%TranslationDisp !enddo enddo ! Loop on wind turbines contains logical function Failed() call SetErrStat(errStat2, errMsg2, errStat, errMsg, 'Set_Mesh_Motion') - Failed = ErrStat >= AbortErrLev + Failed = errStat >= AbortErrLev end function Failed end subroutine Set_Mesh_Motion !---------------------------------------------------------------------------------------------------------------------------------- -!> Set aerodyn inputs -! - cycle values in the input array AD%InputTime and AD%u. -! - set AD input meshes and inflow -subroutine Set_AD_Inputs(nt,dvr,AD,IW,errStat,errMsg) - integer(IntKi) , intent(in ) :: nt ! time step number - type(Dvr_SimData), target, intent(in ) :: dvr ! Driver data - type(AeroDyn_Data), target, intent(inout) :: AD ! AeroDyn data - type(InflowWind_Data), intent(inout) :: IW ! InflowWind data - integer(IntKi) , intent( out) :: errStat ! Status of error message - character(*) , intent( out) :: errMsg ! Error message if ErrStat /= ErrID_None +!> Shift current inputs to old inputs (done because time step constant in driver) +!! NOTE: might not be needed with new ADI module +!! cycle values in the input array AD%InputTime and AD%u. +subroutine Shift_ADI_Inputs(nt, dvr, ADI, errStat, errMsg) + integer(IntKi) , intent(in ) :: nt ! time step number + type(Dvr_SimData), intent(in ) :: dvr ! Driver data + type(ADI_Data), intent(inout) :: ADI !< AeroDyn/InflowWind Data + integer(IntKi) , intent( out) :: errStat !< Status of error message + character(*) , intent( out) :: errMsg !< Error message if errStat /= ErrID_None ! local variables integer(intKi) :: j ! loop index - integer(intKi) :: iWT ! loop counter for rotors - integer(intKi) :: iB ! loop counter for blades integer(IntKi) :: errStat2 ! local status of error message - character(ErrMsgLen) :: errMsg2 ! local error message if ErrStat /= ErrID_None - type(WTData), pointer :: wt ! Alias to shorten notation + character(ErrMsgLen) :: errMsg2 ! local error message if errStat /= ErrID_None real(ReKi) :: z errStat = ErrID_None errMsg = "" - - ! --- Shift previous calculations: do j = numInp-1,1,-1 - call AD_CopyInput (AD%u(j), AD%u(j+1), MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return - AD%inputTime(j+1) = AD%inputTime(j) + call AD_CopyInput (ADI%u(j)%AD, ADI%u(j+1)%AD, MESH_UPDATECOPY, errStat2, ErrMsg2); + call SetErrStat(errStat2, errMsg2, errStat, errMsg, 'Shift_ADI_Inputs') + ADI%inputTimes(j+1) = ADI%inputTimes(j) end do - AD%inputTime(1) = dvr%dT * nt ! time at "nt+1" - - ! --- Transfer motion from "ED" to AeroDyn - do iWT=1,dvr%numTurbines - wt => dvr%WT(iWT) - ! Hub 2 Hub AD - call Transfer_Point_to_Point(wt%hub%ptMesh, AD%u(1)%rotors(iWT)%hubMotion, wt%hub%ED_P_2_AD_P_H, errStat2, errMsg2); if(Failed()) return - - ! Nac 2 Nac AD - call Transfer_Point_to_Point(wt%nac%ptMesh, AD%u(1)%rotors(iWT)%nacelleMotion, wt%nac%ED_P_2_AD_P_N, errStat2, errMsg2); if(Failed()) return - - ! Blade root to blade root AD - do iB = 1,wt%numBlades - call Transfer_Point_to_Point(wt%bld(iB)%ptMesh, AD%u(1)%rotors(iWT)%BladeRootMotion(iB), wt%bld(iB)%ED_P_2_AD_P_R, errStat2, errMsg2); if(Failed()) return - enddo - - ! Blade root AD to blade line AD - do iB = 1,wt%numBlades - call Transfer_Point_to_Line2(AD%u(1)%rotors(iWT)%BladeRootMotion(iB), AD%u(1)%rotors(iWT)%BladeMotion(iB), wt%bld(iB)%AD_P_2_AD_L_B, errStat2, errMsg2); if(Failed()) return - enddo - - ! Tower motion - if (wt%hasTower) then - if (AD%u(1)%rotors(iWT)%TowerMotion%nNodes>0) then - call Transfer_Point_to_Point(wt%twr%ptMesh, wt%twr%ptMeshAD, wt%twr%ED_P_2_AD_P_T, errStat2, errMsg2); if(Failed()) return - call Transfer_Point_to_Line2(wt%twr%ptMeshAD, AD%u(1)%rotors(iWT)%TowerMotion, wt%twr%AD_P_2_AD_L_T, errStat2, errMsg2); if(Failed()) return - endif - endif - enddo ! iWT, rotors - - ! --- Inflow on points - call Set_IW_Inputs(nt, dvr, AD%u(1), AD%OtherState, IW%u(1), errStat2, errMsg2); if(Failed()) return - if (dvr%CompInflow==1) then - call InflowWind_CalcOutput(AD%inputTime(1), IW%u(1), IW%p, IW%x, IW%xd, IW%z, IW%OtherSt, IW%y, IW%m, errStat2, errMsg2); if (Failed()) return - else - do j=1,size(IW%u(1)%PositionXYZ,2) - z = IW%u(1)%PositionXYZ(3,j) - IW%y%VelocityUVW(1,j) = dvr%HWindSpeed*(z/dvr%RefHt)**dvr%PLExp - IW%y%VelocityUVW(2,j) = 0.0_ReKi !V - IW%y%VelocityUVW(3,j) = 0.0_ReKi !W - end do - endif - call AD_InputSolve_IfW(AD%u(1), IW%y, errStat2, errMsg2); if(Failed()) return - -contains - logical function Failed() - call SetErrStat(errStat2, errMsg2, errStat, errMsg, 'Set_AD_Inputs') - Failed = ErrStat >= AbortErrLev - end function Failed -end subroutine Set_AD_Inputs - -!> Set inputs for inflow wind -!! Similar to FAST_Solver, IfW_InputSolve -subroutine Set_IW_Inputs(nt,dvr,u_AD,o_AD,u_IfW,errStat,errMsg) - integer(IntKi) , intent(in ) :: nt ! time step number - type(Dvr_SimData), target, intent(in ) :: dvr ! Driver data - type(AD_InputType), intent(in ) :: u_AD ! AeroDyn data - type(AD_OtherStateType), intent(in ) :: o_AD ! AeroDyn data - type(InflowWind_InputType), intent(inout) :: u_IfW ! InflowWind data - integer(IntKi) , intent( out) :: errStat ! Status of error message - character(*) , intent( out) :: errMsg ! Error message if ErrStat /= ErrID_None - integer :: k,j,node, iWT - ErrStat = ErrID_None - ErrMsg = '' - Node=0 - - - ! Order important! - - ! Hub Height point for each turbine - do iWT=1,dvr%numTurbines - Node = Node + 1 - u_IfW%PositionXYZ(:,Node) = dvr%wt(iWT)%hub%ptMesh%Position(:,1) + dvr%wt(iWT)%hub%ptMesh%TranslationDisp(:,1) - enddo - - do iWT=1,dvr%numTurbines - ! Blade - do K = 1,SIZE(u_AD%rotors(iWT)%BladeMotion) - do J = 1,u_AD%rotors(iWT)%BladeMotion(k)%Nnodes - Node = Node + 1 - u_IfW%PositionXYZ(:,Node) = u_AD%rotors(iWT)%BladeMotion(k)%TranslationDisp(:,j) + u_AD%rotors(iWT)%BladeMotion(k)%Position(:,j) - end do !J = 1,p%BldNodes ! Loop through the blade nodes / elements - end do !K = 1,p%NumBl - ! Tower - do J=1,u_AD%rotors(iWT)%TowerMotion%nnodes - Node = Node + 1 - u_IfW%PositionXYZ(:,Node) = u_AD%rotors(iWT)%TowerMotion%TranslationDisp(:,J) + u_AD%rotors(iWT)%TowerMotion%Position(:,J) - end do - ! Nacelle - if (u_AD%rotors(iWT)%NacelleMotion%Committed) then - Node = Node + 1 - u_IfW%PositionXYZ(:,Node) = u_AD%rotors(iWT)%NacelleMotion%TranslationDisp(:,1) + u_AD%rotors(iWT)%NacelleMotion%Position(:,1) - end if - ! Hub - if (u_AD%rotors(iWT)%HubMotion%Committed) then - Node = Node + 1 - u_IfW%PositionXYZ(:,Node) = u_AD%rotors(iWT)%HubMotion%TranslationDisp(:,1) + u_AD%rotors(iWT)%HubMotion%Position(:,1) - end if - ! TailFin - if (u_AD%rotors(iWT)%TFinMotion%Committed) then - Node = Node + 1 - u_IfW%PositionXYZ(:,Node) = u_AD%rotors(iWT)%TFinMotion%TranslationDisp(:,1) + u_AD%rotors(iWT)%TFinMotion%Position(:,1) - end if - - enddo ! iWT - ! vortex points from FVW in AD15 - if (allocated(o_AD%WakeLocationPoints)) then - do J=1,size(o_AD%WakeLocationPoints,DIM=2) - Node = Node + 1 - u_IfW%PositionXYZ(:,Node) = o_AD%WakeLocationPoints(:,J) - ! rewrite the history of this so that extrapolation doesn't make a mess of things -! do k=2,size(IW%u) -! if (allocated(IW%u(k)%PositionXYZ)) IW%u(k)%PositionXYZ(:,Node) = IW%u(1)%PositionXYZ(:,Node) -! end do - enddo !j, wake points - end if -end subroutine Set_IW_Inputs - -!> This routine sets the AeroDyn wind inflow inputs. -!! See similar routine in FAST_Solver -subroutine AD_InputSolve_IfW(u_AD, y_IfW, errStat, errMsg) - ! Passed variables - TYPE(AD_InputType), INTENT(INOUT) :: u_AD !< The inputs to AeroDyn - TYPE(InflowWind_OutputType), INTENT(IN) :: y_IfW !< The outputs from InflowWind - INTEGER(IntKi) :: errStat !< Error status of the operation - CHARACTER(*) :: errMsg !< Error message if ErrStat /= ErrID_None - ! Local variables: - INTEGER(IntKi) :: J ! Loops through nodes / elements. - INTEGER(IntKi) :: K ! Loops through blades. - INTEGER(IntKi) :: NumBl - INTEGER(IntKi) :: NNodes - INTEGER(IntKi) :: node - INTEGER(IntKi) :: iWT - errStat = ErrID_None - errMsg = "" - node = 1 - - ! Order important! - - do iWT=1,size(u_AD%rotors) - node = node + 1 ! Hub velocities for each rotor - enddo - - do iWT=1,size(u_AD%rotors) - NumBl = size(u_AD%rotors(iWT)%InflowOnBlade,3) - Nnodes = size(u_AD%rotors(iWT)%InflowOnBlade,2) - ! Blades - do k=1,NumBl - do j=1,Nnodes - u_AD%rotors(iWT)%InflowOnBlade(:,j,k) = y_IfW%VelocityUVW(:,node) - node = node + 1 - end do - end do - ! Tower - if ( allocated(u_AD%rotors(iWT)%InflowOnTower) ) then - Nnodes = size(u_AD%rotors(iWT)%InflowOnTower,2) - do j=1,Nnodes - u_AD%rotors(iWT)%InflowOnTower(:,j) = y_IfW%VelocityUVW(:,node) - node = node + 1 - end do - end if - ! Nacelle - if (u_AD%rotors(iWT)%NacelleMotion%NNodes > 0) then - u_AD%rotors(iWT)%InflowOnNacelle(:) = y_IfW%VelocityUVW(:,node) - node = node + 1 - else - u_AD%rotors(iWT)%InflowOnNacelle = 0.0_ReKi - end if - ! Hub - if (u_AD%rotors(iWT)%HubMotion%NNodes > 0) then - u_AD%rotors(iWT)%InflowOnHub(:) = y_IfW%VelocityUVW(:,node) - node = node + 1 - else - u_AD%rotors(iWT)%InflowOnHub = 0.0_ReKi - end if - ! TailFin - if (u_AD%rotors(iWT)%TFinMotion%NNodes > 0) then - u_AD%rotors(iWT)%InflowOnTailFin(:) = y_IfW%VelocityUVW(:,node) - node = node + 1 - else - u_AD%rotors(iWT)%InflowOnTailFin = 0.0_ReKi - end if - enddo ! rotors - ! OLAF points - if ( allocated(u_AD%InflowWakeVel) ) then - Nnodes = size(u_AD%InflowWakeVel,DIM=2) - do j=1,Nnodes - u_AD%InflowWakeVel(:,j) = y_IfW%VelocityUVW(:,node) - node = node + 1 - end do !j, wake points - end if -end subroutine AD_InputSolve_IfW - - + ADI%inputTimes(1) = dvr%dT * nt ! time at "nt+1" +end subroutine Shift_ADI_Inputs !---------------------------------------------------------------------------------------------------------------------------------- !> Read the driver input file @@ -1266,8 +893,8 @@ subroutine Dvr_ReadInputFile(fileName, dvr, errStat, errMsg ) ! Basic inputs real(ReKi) :: hubRad, hubHt, overhang, shftTilt, precone, twr2Shft ! Basic inputs when basicHAWTFormat is true real(ReKi) :: nacYaw, bldPitch, rotSpeed - ErrStat = ErrID_None - ErrMsg = '' + errStat = ErrID_None + errMsg = '' UnIn = -1 UnEc = -1 @@ -1309,30 +936,30 @@ subroutine Dvr_ReadInputFile(fileName, dvr, errStat, errMsg ) ! --- Inflow data call ParseCom(FileInfo_In, CurLine, Line, errStat2, errMsg2, unEc); if (Failed()) return - call ParseVar(FileInfo_In, CurLine, "compInflow", dvr%compInflow , errStat2, errMsg2, unEc); if (Failed()) return - call ParseVar(FileInfo_In, CurLine, "InflowFile", dvr%IW_InputFile, errStat2, errMsg2, unEc); if (Failed()) return - if (dvr%compInflow==0) then - call ParseVar(FileInfo_In, CurLine, "HWindSpeed", dvr%HWindSpeed , errStat2, errMsg2, unEc); if (Failed()) return - call ParseVar(FileInfo_In, CurLine, "RefHt" , dvr%RefHt , errStat2, errMsg2, unEc); if (Failed()) return - call ParseVar(FileInfo_In, CurLine, "PLExp" , dvr%PLExp , errStat2, errMsg2, unEc); if (Failed()) return + call ParseVar(FileInfo_In, CurLine, "compInflow", dvr%IW_InitInp%compInflow , errStat2, errMsg2, unEc); if (Failed()) return + call ParseVar(FileInfo_In, CurLine, "InflowFile", dvr%IW_InitInp%InputFile, errStat2, errMsg2, unEc); if (Failed()) return + if (dvr%IW_InitInp%compInflow==0) then + call ParseVar(FileInfo_In, CurLine, "HWindSpeed", dvr%IW_InitInp%HWindSpeed , errStat2, errMsg2, unEc); if (Failed()) return + call ParseVar(FileInfo_In, CurLine, "RefHt" , dvr%IW_InitInp%RefHt , errStat2, errMsg2, unEc); if (Failed()) return + call ParseVar(FileInfo_In, CurLine, "PLExp" , dvr%IW_InitInp%PLExp , errStat2, errMsg2, unEc); if (Failed()) return else call ParseCom(FileInfo_In, CurLine, Line, errStat2, errMsg2, unEc); if (Failed()) return call ParseCom(FileInfo_In, CurLine, Line, errStat2, errMsg2, unEc); if (Failed()) return call ParseCom(FileInfo_In, CurLine, Line, errStat2, errMsg2, unEc); if (Failed()) return - dvr%PLexp = myNaN - dvr%RefHt = myNaN - dvr%HWindSpeed = myNaN + dvr%IW_InitInp%PLexp = myNaN + dvr%IW_InitInp%RefHt = myNaN + dvr%IW_InitInp%HWindSpeed = myNaN endif if (PathIsRelative(dvr%AD_InputFile)) dvr%AD_InputFile = trim(PriPath)//trim(dvr%AD_InputFile) - if (PathIsRelative(dvr%IW_InputFile)) dvr%IW_InputFile = trim(PriPath)//trim(dvr%IW_InputFile) + if (PathIsRelative(dvr%IW_InitInp%InputFile)) dvr%IW_InitInp%InputFile = trim(PriPath)//trim(dvr%IW_InitInp%InputFile) ! --- Turbines call ParseCom(FileInfo_In, CurLine, Line, errStat2, errMsg2, unEc); if (Failed()) return call ParseVar(FileInfo_In, CurLine, "numTurbines", dvr%numTurbines, errStat2, errMsg2, unEc); if (Failed()) return - allocate(dvr%WT(dvr%numTurbines), stat=ErrStat2) - if (ErrStat2 /=0) then - ErrStat2=ErrID_Fatal + allocate(dvr%WT(dvr%numTurbines), stat=errStat2) + if (errStat2 /=0) then + errStat2=ErrID_Fatal ErrMsg2="Error allocating dvr%WT." if(Failed()) return end if @@ -1345,8 +972,9 @@ subroutine Dvr_ReadInputFile(fileName, dvr, errStat, errMsg ) !call ParseVar(FileInfo_In, CurLine, 'ProjMod'//sWT , wt%projMod , errStat2, errMsg2, unEc); if(Failed()) return call ParseVar(FileInfo_In, CurLine, 'ProjMod'//sWT , wt%projMod , errStat2, errMsg2, unEc); if (errStat2==ErrID_Fatal) then - call WrScr('>>> ProjMod is not present in AeroDyn driver input file.') wt%projMod = -1 + else + call WrScr('>>> ProjMod is present in AeroDyn driver input file. ProjMod: '//trim(num2lstr(wt%projMod))) endif call ParseVar(FileInfo_In, CurLine, 'BasicHAWTFormat'//sWT , wt%basicHAWTFormat , errStat2, errMsg2, unEc); if(Failed()) return @@ -1405,10 +1033,10 @@ subroutine Dvr_ReadInputFile(fileName, dvr, errStat, errMsg ) ! Blades call ParseCom(FileInfo_In, CurLine, Line, errStat2, errMsg2, unEc); if(Failed()) return call ParseVar(FileInfo_In, CurLine, 'numBlades'//sWT , wt%numBlades, errStat2, errMsg2, unEc); if(Failed()) return - allocate(wt%bld(wt%numBlades), stat=ErrStat2) + allocate(wt%bld(wt%numBlades), stat=errStat2) if (errStat2 /= 0) then - ErrStat2=ErrID_Fatal - ErrMsg2 = "Error allocating wt%bld" + errStat2=ErrID_Fatal + errMsg2 = "Error allocating wt%bld" if(Failed()) return end if @@ -1612,14 +1240,14 @@ logical function Check(Condition, ErrMsg_in) character(len=*), intent(in) :: ErrMsg_in Check=Condition if (Check) then - call SetErrStat(ErrID_Fatal, trim(ErrMsg_in), ErrStat, ErrMsg, 'Dvr_ReadInputFile'); + call SetErrStat(ErrID_Fatal, trim(ErrMsg_in), errStat, errMsg, 'Dvr_ReadInputFile'); endif end function Check subroutine CleanUp() if (UnIn>0) close(UnIn) if (UnEc>0) close(UnEc) - CALL NWTC_Library_Destroyfileinfotype(FileInfo_In, ErrStat2, ErrMsg2) + CALL NWTC_Library_Destroyfileinfotype(FileInfo_In, errStat2, errMsg2) end subroutine cleanup logical function Failed() @@ -1630,7 +1258,8 @@ logical function Failed() endif end function Failed end subroutine Dvr_ReadInputFile - +!---------------------------------------------------------------------------------------------------------------------------------- +!> Set simple motion on this turbine subroutine setSimpleMotion(wt, rotSpeed, bldPitch, nacYaw, DOF, amplitude, frequency) type(WTData), intent(inout) :: wt real(ReKi), intent(in ) :: rotSpeed ! rpm @@ -1655,9 +1284,8 @@ subroutine setSimpleMotion(wt, rotSpeed, bldPitch, nacYaw, DOF, amplitude, frequ end do end if end subroutine setSimpleMotion - - !---------------------------------------------------------------------------------------------------------------------------------- +!> Validate inputs read from input file subroutine ValidateInputs(dvr, errStat, errMsg) type(Dvr_SimData), target, intent(inout) :: dvr ! intent(out) only so that we can save FmtWidth in dvr%out%ActualChanLen integer, intent( out) :: errStat ! returns a non-zero value when an error occurs @@ -1665,30 +1293,29 @@ subroutine ValidateInputs(dvr, errStat, errMsg) ! local variables: integer(intKi) :: i integer(intKi) :: FmtWidth ! number of characters in string produced by dvr%OutFmt - integer(intKi) :: ErrStat2 ! temporary Error status + integer(intKi) :: errStat2 ! temporary Error status character(ErrMsgLen) :: ErrMsg2 ! temporary Error message character(*), parameter :: RoutineName = 'ValidateInputs' integer :: iWT, iB type(WTData), pointer :: wt ! Alias to shorten notation - ErrStat = ErrID_None - ErrMsg = "" + errStat = ErrID_None + errMsg = "" ! Turbine Data: - !if ( dvr%numBlades < 1 ) call SetErrStat( ErrID_Fatal, "There must be at least 1 blade (numBlades).", ErrStat, ErrMsg, RoutineName) + !if ( dvr%numBlades < 1 ) call SetErrStat( ErrID_Fatal, "There must be at least 1 blade (numBlades).", errStat, ErrMsg, RoutineName) ! Combined-Case Analysis: if (dvr%MHK /= 0 .and. dvr%MHK /= 1 .and. dvr%MHK /= 2) call SetErrStat(ErrID_Fatal, 'MHK switch must be 0, 1, or 2.', ErrStat, ErrMsg, RoutineName) if (dvr%MHK == 2) call SetErrStat(ErrID_Fatal, 'Functionality to model a floating MHK turbine has not yet been implemented.', ErrStat, ErrMsg, RoutineName) - if (dvr%DT < epsilon(0.0_ReKi) ) call SetErrStat(ErrID_Fatal,'dT must be larger than 0.',ErrStat, ErrMsg,RoutineName) - if (Check(.not.(ANY((/0,1/) == dvr%compInflow) ), 'CompInflow needs to be 0 or 1')) return + if (dvr%DT < epsilon(0.0_ReKi) ) call SetErrStat(ErrID_Fatal,'dT must be larger than 0.',errStat, errMsg,RoutineName) + if (Check(.not.(ANY((/0,1/) == dvr%IW_InitInp%compInflow) ), 'CompInflow needs to be 0 or 1')) return if (Check(.not.(ANY(idAnalysisVALID == dvr%analysisType )), 'Analysis type not supported: '//trim(Num2LStr(dvr%analysisType)) )) return if (dvr%analysisType==idAnalysisTimeD .or. dvr%analysisType==idAnalysisCombi) then - if (Check( dvr%CompInflow/=0, 'CompInflow needs to be 0 when analysis type is '//trim(Num2LStr(dvr%analysisType)))) return + if (Check( dvr%IW_InitInp%CompInflow/=0, 'CompInflow needs to be 0 when analysis type is '//trim(Num2LStr(dvr%analysisType)))) return endif - if (dvr%WtrDpth < 0.0_ReKi) call SetErrStat(ErrID_Fatal, 'WtrDpth must not be negative.', ErrStat, ErrMsg, RoutineName) do iWT=1,dvr%numTurbines wt => dvr%WT(iWT) @@ -1707,10 +1334,10 @@ subroutine ValidateInputs(dvr, errStat, errMsg) ! --- I-O Settings: if (Check(.not.(ANY(idFmtVALID == dvr%out%fileFmt)), 'fileFmt not supported: '//trim(Num2LStr(dvr%out%fileFmt)) )) return - call ChkRealFmtStr( dvr%out%OutFmt, 'OutFmt', FmtWidth, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + call ChkRealFmtStr( dvr%out%OutFmt, 'OutFmt', FmtWidth, errStat2, errMsg2 ) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) !if ( FmtWidth < MinChanLen ) call SetErrStat( ErrID_Warn, 'OutFmt produces a column less than '//trim(num2lstr(MinChanLen))//' characters wide ('// & - ! TRIM(Num2LStr(FmtWidth))//'), which may be too small.', ErrStat, ErrMsg, RoutineName ) + ! TRIM(Num2LStr(FmtWidth))//'), which may be too small.', errStat, errMsg, RoutineName ) if (Check((dvr%out%WrVTK<0 .or. dvr%out%WrVTK>2 ), 'WrVTK must be 0 (none), 1 (initialization only), 2 (animation), or 3 (mode shapes).')) then return @@ -1725,19 +1352,19 @@ logical function Check(Condition, ErrMsg_in) character(len=*), intent(in) :: ErrMsg_in Check=Condition if (Check) then - call SetErrStat(ErrID_Fatal, trim(ErrMsg_in), ErrStat, ErrMsg, 'ValidateInputs'); + call SetErrStat(ErrID_Fatal, trim(ErrMsg_in), errStat, errMsg, 'ValidateInputs'); endif end function Check end subroutine ValidateInputs - !---------------------------------------------------------------------------------------------------------------------------------- +!> Initialize outputs to file for driver subroutine Dvr_InitializeOutputs(nWT, out, numSteps, errStat, errMsg) integer(IntKi) , intent(in ) :: nWT ! Number of time steps - type(Dvr_Outputs), intent(inout) :: out + type(Dvr_Outputs), intent(inout) :: out integer(IntKi) , intent(in ) :: numSteps ! Number of time steps integer(IntKi) , intent( out) :: errStat ! Status of error message - character(*) , intent( out) :: errMsg ! Error message if ErrStat /= ErrID_None + character(*) , intent( out) :: errMsg ! Error message if errStat /= ErrID_None ! locals integer(IntKi) :: i integer(IntKi) :: numSpaces @@ -1778,13 +1405,13 @@ subroutine Dvr_InitializeOutputs(nWT, out, numSteps, errStat, errMsg) else sWT = '' endif - call GetNewUnit(out%unOutFile(iWT), ErrStat, ErrMsg) - if ( ErrStat >= AbortErrLev ) then + call GetNewUnit(out%unOutFile(iWT), errStat, errMsg) + if ( errStat >= AbortErrLev ) then out%unOutFile(iWT) = -1 return end if - call OpenFOutFile ( out%unOutFile(iWT), trim(out%Root)//trim(sWT)//'.out', ErrStat, ErrMsg ) - if ( ErrStat >= AbortErrLev ) return + call OpenFOutFile ( out%unOutFile(iWT), trim(out%Root)//trim(sWT)//'.out', errStat, errMsg ) + if ( errStat >= AbortErrLev ) return write (out%unOutFile(iWT),'(/,A)') 'Predictions were generated on '//CurDate()//' at '//CurTime()//' using '//trim( version%Name ) write (out%unOutFile(iWT),'(1X,A)') trim(GetNVD(out%AD_ver)) write (out%unOutFile(iWT),'()' ) !print a blank line @@ -1815,11 +1442,17 @@ end subroutine Dvr_InitializeOutputs !---------------------------------------------------------------------------------------------------------------------------------- !> Initialize driver (not module-level) output channels !! Output channels are constant for all cases and all turbines for now! -subroutine Dvr_InitializeDriverOutputs(dvr, errStat, errMsg) - type(Dvr_SimData), intent(inout) :: dvr ! driver data - integer(IntKi) , intent( out) :: errStat ! Status of error message - character(*) , intent( out) :: errMsg ! Error message if ErrStat /= ErrID_None - integer :: maxNumBlades, k, j, iWT +subroutine Dvr_InitializeDriverOutputs(dvr, ADI, errStat, errMsg) + type(Dvr_SimData), intent(inout) :: dvr ! driver data + type(ADI_Data), intent(inout) :: ADI ! Input data for initialization (intent out for getting AD WriteOutput names/units) + integer(IntKi) , intent( out) :: errStat ! Status of error message + character(*) , intent( out) :: errMsg ! Error message if errStat /= ErrID_None + character(len=ChanLen), dimension(:), allocatable :: userSwapHdr !< Array of headers for user Swap Array + character(len=ChanLen), dimension(:), allocatable :: userSwapUnt !< Array of units for user Swap Array + integer :: maxNumBlades, k, j, iWT + logical :: hasSwapArray ! small hack, if a swap array is present NOTE: we don't know the size of it... + integer(IntKi) :: errStat2 ! Status of error message + character(ErrMsgLen) :: errMsg2 ! Error message errStat = ErrID_None errMsg = '' @@ -1830,69 +1463,88 @@ subroutine Dvr_InitializeDriverOutputs(dvr, errStat, errMsg) ! --- Allocate driver-level outputs dvr%out%nDvrOutputs = 1+ 4 + 6 + 3 + 1*maxNumBlades ! - allocate(dvr%out%WriteOutputHdr(1+dvr%out%nDvrOutputs)) - allocate(dvr%out%WriteOutputUnt(1+dvr%out%nDvrOutputs)) + + ! Initialize swap arrays + hasSwapArray=.false. do iWT =1,dvr%numTurbines - allocate(dvr%WT(iWT)%WriteOutput(1+dvr%out%nDvrOutputs)) + ! NOTE: same swap array for all turbines (outputs are expected to the same for all turbines) + if (dvr%WT(iWT)%hub%motionType == idHubMotionUserFunction) then + hasSwapArray=.true. + if (allocated(userSwapHdr)) deallocate(userSwapHdr) + if (allocated(userSwapUnt)) deallocate(userSwapUnt) + call userHubMotion_Init(dvr%wt(iWT)%userSwapArray, userSwapHdr, userSwapUnt, errStat2, errMsg2); if(Failed()) return + endif enddo + if (hasSwapArray) then + dvr%out%nDvrOutputs = dvr%out%nDvrOutputs + size(userSwapHdr) + endif - j=1 - dvr%out%WriteOutputHdr(j) = 'Time' - dvr%out%WriteOutputUnt(j) = '(s)' ; j=j+1 - dvr%out%WriteOutputHdr(j) = 'Case' - dvr%out%WriteOutputUnt(j) = '(-)' ; j=j+1 - - dvr%out%WriteOutputHdr(j) = 'HWindSpeedX' - dvr%out%WriteOutputUnt(j) = '(m/s)'; j=j+1 - dvr%out%WriteOutputHdr(j) = 'HWindSpeedY' - dvr%out%WriteOutputUnt(j) = '(m/s)'; j=j+1 - dvr%out%WriteOutputHdr(j) = 'HWindSpeedZ' - dvr%out%WriteOutputUnt(j) = '(m/s)'; j=j+1 + call AllocAry(dvr%out%WriteOutputHdr, 1+dvr%out%nDvrOutputs, 'WriteOutputHdr', errStat2, errMsg2); if(Failed()) return + call AllocAry(dvr%out%WriteOutputUnt, 1+dvr%out%nDvrOutputs, 'WriteOutputUnt', errStat2, errMsg2); if(Failed()) return + do iWT =1,dvr%numTurbines + call AllocAry(dvr%WT(iWT)%WriteOutput, 1+dvr%out%nDvrOutputs, 'WriteOutputWT', errStat2, errMsg2);if(Failed()) return + enddo + + j=1 + dvr%out%WriteOutputHdr(j) = 'Time' ; dvr%out%WriteOutputUnt(j) = '(s)' ; j=j+1 + dvr%out%WriteOutputHdr(j) = 'Case' ; dvr%out%WriteOutputUnt(j) = '(-)' ; j=j+1 + dvr%out%WriteOutputHdr(j) = 'HWindSpeedX' ; dvr%out%WriteOutputUnt(j) = '(m/s)'; j=j+1 + dvr%out%WriteOutputHdr(j) = 'HWindSpeedY' ; dvr%out%WriteOutputUnt(j) = '(m/s)'; j=j+1 + dvr%out%WriteOutputHdr(j) = 'HWindSpeedZ' ; dvr%out%WriteOutputUnt(j) = '(m/s)'; j=j+1 dvr%out%WriteOutputHdr(j) = 'ShearExp' - if (dvr%CompInflow==1) then + if (ADI%m%IW%CompInflow==1) then dvr%out%WriteOutputUnt(j) = '(INVALID)'; j=j+1 else dvr%out%WriteOutputUnt(j) = '(-)'; j=j+1 endif - - dvr%out%WriteOutputHdr(j) = 'PtfmSurge' - dvr%out%WriteOutputUnt(j) = '(m)'; j=j+1 - dvr%out%WriteOutputHdr(j) = 'PtfmSway' - dvr%out%WriteOutputUnt(j) = '(m)'; j=j+1 - dvr%out%WriteOutputHdr(j) = 'PtfmHeave' - dvr%out%WriteOutputUnt(j) = '(m)'; j=j+1 - dvr%out%WriteOutputHdr(j) = 'PtfmRoll' - dvr%out%WriteOutputUnt(j) = '(deg)'; j=j+1 - dvr%out%WriteOutputHdr(j) = 'PtfmPitch' - dvr%out%WriteOutputUnt(j) = '(deg)'; j=j+1 - dvr%out%WriteOutputHdr(j) = 'PtfmYaw' - dvr%out%WriteOutputUnt(j) = '(deg)'; j=j+1 - - dvr%out%WriteOutputHdr(j) = 'Yaw' - dvr%out%WriteOutputUnt(j) = '(deg)'; j=j+1 - dvr%out%WriteOutputHdr(j) = 'Azimuth' - dvr%out%WriteOutputUnt(j) = '(deg)'; j=j+1 - dvr%out%WriteOutputHdr(j) = 'RotSpeed' - dvr%out%WriteOutputUnt(j) = '(rpm)'; j=j+1 + dvr%out%WriteOutputHdr(j) = 'PtfmSurge' ; dvr%out%WriteOutputUnt(j) = '(m)' ; j=j+1 + dvr%out%WriteOutputHdr(j) = 'PtfmSway' ; dvr%out%WriteOutputUnt(j) = '(m)' ; j=j+1 + dvr%out%WriteOutputHdr(j) = 'PtfmHeave' ; dvr%out%WriteOutputUnt(j) = '(m)' ; j=j+1 + dvr%out%WriteOutputHdr(j) = 'PtfmRoll' ; dvr%out%WriteOutputUnt(j) = '(deg)'; j=j+1 + dvr%out%WriteOutputHdr(j) = 'PtfmPitch' ; dvr%out%WriteOutputUnt(j) = '(deg)'; j=j+1 + dvr%out%WriteOutputHdr(j) = 'PtfmYaw' ; dvr%out%WriteOutputUnt(j) = '(deg)'; j=j+1 + dvr%out%WriteOutputHdr(j) = 'Yaw' ; dvr%out%WriteOutputUnt(j) = '(deg)'; j=j+1 + dvr%out%WriteOutputHdr(j) = 'Azimuth' ; dvr%out%WriteOutputUnt(j) = '(deg)'; j=j+1 + dvr%out%WriteOutputHdr(j) = 'RotSpeed' ; dvr%out%WriteOutputUnt(j) = '(rpm)'; j=j+1 do k =1,maxNumBlades dvr%out%WriteOutputHdr(j) = 'BldPitch'//trim(num2lstr(k)) dvr%out%WriteOutputUnt(j) = '(deg)'; j=j+1 enddo + if (hasSwapArray) then + do k =1,size(userSwapHdr) + dvr%out%WriteOutputHdr(j) = userSwapHdr(k) + dvr%out%WriteOutputUnt(j) = userSwapUnt(k) + j=j+1 + enddo + endif +contains + logical function Failed() + CALL SetErrStat(errStat2, errMsg2, errStat, errMsg, 'Dvr_InitializeDriverOutputs' ) + Failed = errStat >= AbortErrLev + if (Failed) then + if (allocated(userSwapHdr)) deallocate(userSwapHdr) + if (allocated(userSwapUnt)) deallocate(userSwapUnt) + endif + end function Failed end subroutine Dvr_InitializeDriverOutputs !---------------------------------------------------------------------------------------------------------------------------------- !> Store driver data -subroutine Dvr_CalcOutputDriver(dvr, y_Ifw, errStat, errMsg) +subroutine Dvr_CalcOutputDriver(dvr, y_ADI, FED, errStat, errMsg) type(Dvr_SimData), target, intent(inout) :: dvr ! driver data - type(InflowWind_OutputType), intent(in ) :: y_Ifw ! driver data - integer(IntKi) , intent( out) :: errStat ! Status of error message - character(*) , intent( out) :: errMsg ! Error message if ErrStat /= ErrID_None + type(FED_Data), target, intent(in ) :: FED !< Elastic wind turbine data (Fake ElastoDyn) + type(ADI_OutputType), intent(in ) :: y_ADI ! ADI output data + integer(IntKi) , intent( out) :: errStat ! Status of error message + character(*) , intent( out) :: errMsg ! Error message if errStat /= ErrID_None integer :: maxNumBlades, k, j, iWT real(ReKi) :: rotations(3) integer(IntKi) :: errStat2 ! Status of error message character(ErrMsgLen) :: errMsg2 ! Error message - real(ReKi), pointer :: arr(:) + real(ReKi), pointer :: arr(:) + type(WTData), pointer :: wt ! Alias to shorten notation + type(RotFED), pointer :: y_ED ! Alias to shorten notation + errStat = ErrID_None errMsg = '' @@ -1900,53 +1552,63 @@ subroutine Dvr_CalcOutputDriver(dvr, y_Ifw, errStat, errMsg) do iWT=1,size(dvr%WT) maxNumBlades= max(maxNumBlades, dvr%WT(iWT)%numBlades) end do + + ! Determine if a swap array is present do iWT = 1, dvr%numTurbines + wt => dvr%wt(iWT) + y_ED => FED%wt(iWT) if (dvr%wt(iWT)%numBlades >0 ) then ! TODO, export for tower only arr => dvr%wt(iWT)%WriteOutput k=1 ! NOTE: to do this properly we would need to store at the previous time step and perform a rotation - arr(k) = dvr%iCase ; k=k+1 + arr(k) = dvr%iCase ; k=k+1 ! Environment - arr(k) = y_Ifw%VelocityUVW(1, iWT) ; k=k+1 ! NOTE: stored at beginning of array - arr(k) = y_Ifw%VelocityUVW(2, iWT) ; k=k+1 - arr(k) = y_Ifw%VelocityUVW(3, iWT) ; k=k+1 - arr(k) = dvr%PLExp ; k=k+1 ! shear exp, not set if CompInflow=1 + arr(k) = y_ADI%HHVel(1, iWT) ; k=k+1 ! NOTE: stored at beginning of array + arr(k) = y_ADI%HHVel(2, iWT) ; k=k+1 + arr(k) = y_ADI%HHVel(3, iWT) ; k=k+1 + arr(k) = y_ADI%PLExp ; k=k+1 ! shear exp, not set if CompInflow=1 ! 6 base DOF - rotations = EulerExtract(dvr%WT(iWT)%ptMesh%Orientation(:,:,1)); - arr(k) = dvr%WT(iWT)%ptMesh%TranslationDisp(1,1); k=k+1 ! surge - arr(k) = dvr%WT(iWT)%ptMesh%TranslationDisp(2,1); k=k+1 ! sway - arr(k) = dvr%WT(iWT)%ptMesh%TranslationDisp(3,1); k=k+1 ! heave - arr(k) = rotations(1) * R2D ; k=k+1 ! roll - arr(k) = rotations(2) * R2D ; k=k+1 ! pitch - arr(k) = rotations(3) * R2D ; k=k+1 ! yaw + rotations = EulerExtract(y_ED%PlatformPtMesh%Orientation(:,:,1)); + arr(k) = y_ED%PlatformPtMesh%TranslationDisp(1,1); k=k+1 ! surge + arr(k) = y_ED%PlatformPtMesh%TranslationDisp(2,1); k=k+1 ! sway + arr(k) = y_ED%PlatformPtMesh%TranslationDisp(3,1); k=k+1 ! heave + arr(k) = rotations(1) * R2D ; k=k+1 ! roll + arr(k) = rotations(2) * R2D ; k=k+1 ! pitch + arr(k) = rotations(3) * R2D ; k=k+1 ! yaw ! RNA motion - arr(k) = dvr%WT(iWT)%nac%yaw*R2D ; k=k+1 ! yaw [deg] - arr(k) = modulo(real(dvr%WT(iWT)%hub%azimuth+(dvr%dt * dvr%WT(iWT)%hub%rotSpeed)*R2D, ReKi), 360.0_ReKi); k=k+1 ! azimuth [deg], stored at nt-1 - arr(k) = dvr%WT(iWT)%hub%rotSpeed*RPS2RPM; k=k+1 ! rotspeed [rpm] + arr(k) = wt%nac%yaw*R2D ; k=k+1 ! yaw [deg] + arr(k) = modulo(real(wt%hub%azimuth+(dvr%dt * wt%hub%rotSpeed)*R2D, ReKi), 360.0_ReKi); k=k+1 ! azimuth [deg], stored at nt-1 + arr(k) = wt%hub%rotSpeed*RPS2RPM; k=k+1 ! rotspeed [rpm] do j=1,maxNumBlades - if (j<=dvr%WT(iWT)%numBlades) then - arr(k) = dvr%WT(iWT)%bld(j)%pitch*R2D ! pitch [deg] + if (j<= wt%numBlades) then + arr(k) = wt%bld(j)%pitch*R2D ! pitch [deg] else arr(k) = 0.0_ReKi ! myNaN endif k=k+1; enddo + ! Swap array + if (wt%hub%motionType == idHubMotionUserFunction) then + do j=1,size(wt%userSwapArray) + arr(k) = wt%userSwapArray(j); k=k+1; + enddo + endif + endif enddo end subroutine Dvr_CalcOutputDriver !---------------------------------------------------------------------------------------------------------------------------------- -subroutine Dvr_WriteOutputs(nt, t, dvr, out, yAD, yIW, errStat, errMsg) +subroutine Dvr_WriteOutputs(nt, t, dvr, out, yADI, errStat, errMsg) integer(IntKi) , intent(in ) :: nt ! simulation time step real(DbKi) , intent(in ) :: t ! simulation time (s) - type(Dvr_SimData), intent(inout) :: dvr ! driver data - type(Dvr_Outputs) , intent(inout) :: out ! driver uotput options - type(AD_OutputType) , intent(in ) :: yAD ! aerodyn outputs - type(InflowWind_OutputType),intent(in ) :: yIW ! inflowwind outputs + type(Dvr_SimData), intent(inout) :: dvr ! driver data + type(Dvr_Outputs) , intent(inout) :: out ! driver uotput options + type(ADI_OutputType) , intent(in ) :: yADI ! aerodyn outputs integer(IntKi) , intent(inout) :: errStat ! Status of error message - character(*) , intent(inout) :: errMsg ! Error message if ErrStat /= ErrID_None + character(*) , intent(inout) :: errMsg ! Error message if errStat /= ErrID_None ! Local variables. character(ChanLen) :: tmpStr ! temporary string to print the time output as text integer :: nDV , nAD, nIW, iWT, k, j @@ -1957,17 +1619,17 @@ subroutine Dvr_WriteOutputs(nt, t, dvr, out, yAD, yIW, errStat, errMsg) errMsg = '' ! Packing all outputs excpet time into one array - nAD = size(yAD%rotors(1)%WriteOutput) - nIW = size(yIW%WriteOutput) + nAD = size(yADI%AD%rotors(1)%WriteOutput) + nIW = size(yADI%IW_WriteOutput) nDV = out%nDvrOutputs do iWT = 1, dvr%numTurbines if (dvr%wt(iWT)%numBlades >0 ) then ! TODO, export for tower only - out%outLine(1:nDV) = dvr%wt(iWT)%WriteOutput(1:nDV) + out%outLine(1:nDV) = dvr%wt(iWT)%WriteOutput(1:nDV) ! Driver Write Outputs ! out%outLine(11) = dvr%WT(iWT)%hub%azimuth ! azimuth already stored a nt-1 - out%outLine(nDV+1:nDV+nAD) = yAD%rotors(iWT)%WriteOutput - out%outLine(nDV+nAD+1:) = yIW%WriteOutput + out%outLine(nDV+1:nDV+nAD) = yADI%AD%rotors(iWT)%WriteOutput ! AeroDyn WriteOutputs + out%outLine(nDV+nAD+1:) = yADI%IW_WriteOutput ! InflowWind WriteOutputs if (out%fileFmt==idFmtBoth .or. out%fileFmt == idFmtAscii) then ! ASCII @@ -1984,15 +1646,16 @@ subroutine Dvr_WriteOutputs(nt, t, dvr, out, yAD, yIW, errStat, errMsg) endif endif enddo - end subroutine Dvr_WriteOutputs + +!---------------------------------------------------------------------------------------------------------------------------------- !> Read a delimited file with one line of header subroutine ReadDelimFile(Filename, nCol, Array, errStat, errMsg, nHeaderLines, priPath) character(len=*), intent(in) :: Filename integer, intent(in) :: nCol real(ReKi), dimension(:,:), allocatable, intent(out) :: Array integer(IntKi) , intent(out) :: errStat ! Status of error message - character(*) , intent(out) :: errMsg ! Error message if ErrStat /= ErrID_None + character(*) , intent(out) :: errMsg ! Error message if errStat /= ErrID_None integer(IntKi), optional, intent(in ) :: nHeaderLines character(*) , optional, intent(in ) :: priPath ! Primary path, to use if filename is not absolute integer :: UnIn, i, j, nLine, nHead @@ -2000,15 +1663,14 @@ subroutine ReadDelimFile(Filename, nCol, Array, errStat, errMsg, nHeaderLines, p integer(IntKi) :: errStat2 ! local status of error message character(ErrMsgLen) :: errMsg2 ! temporary Error message character(len=2048) :: Filename_Loc ! filename local to this function - ErrStat = ErrID_None - ErrMsg = "" + errStat = ErrID_None + errMsg = "" Filename_Loc = Filename if (present(priPath)) then if (PathIsRelative(Filename_Loc)) Filename_Loc = trim(PriPath)//trim(Filename) endif - ! Open file call GetNewUnit(UnIn) call OpenFInpFile(UnIn, Filename_Loc, errStat2, errMsg2); if(Failed()) return @@ -2040,6 +1702,7 @@ logical function Failed() end function Failed end subroutine ReadDelimFile +!---------------------------------------------------------------------------------------------------------------------------------- !> Counts number of lines in a file integer function line_count(iunit) integer, intent(in) :: iunit @@ -2062,7 +1725,9 @@ integer function line_count(iunit) endif rewind(iunit) return - end function +end function + +!---------------------------------------------------------------------------------------------------------------------------------- !> Perform linear interpolation of an array, where first column is assumed to be ascending time values !! First value is used for times before, and last value is used for time beyond subroutine interpTimeValue(array, time, iLast, values) @@ -2098,31 +1763,33 @@ end subroutine interpTimeValue !---------------------------------------------------------------------------------------------------------------------------------- !> This subroutine sets up the information needed for plotting VTK surfaces. -SUBROUTINE SetVTKParameters(p_FAST, dvr, InitOutData_AD, AD, ErrStat, ErrMsg) - TYPE(Dvr_Outputs), INTENT(INOUT) :: p_FAST !< The parameters of the glue code +subroutine setVTKParameters(p_FAST, dvr, ADI, errStat, errMsg) + type(Dvr_Outputs), intent(inout) :: p_FAST !< The parameters of the glue code type(Dvr_SimData), target, intent(inout) :: dvr ! intent(out) only so that we can save FmtWidth in dvr%out%ActualChanLen - TYPE(AD_InitOutputType), INTENT(INOUT) :: InitOutData_AD !< The initialization output from AeroDyn - TYPE(AeroDyn_Data), target, INTENT(IN ) :: AD !< AeroDyn data - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - REAL(SiKi) :: RefPoint(3), RefLengths(2) - REAL(SiKi) :: x, y - REAL(SiKi) :: TwrDiam_top, TwrDiam_base, TwrRatio, TwrLength - INTEGER(IntKi) :: topNode, baseNode, cylNode, tipNode, rootNode - INTEGER(IntKi) :: NumBl, k, iRot, iBld, nNodes - CHARACTER(1024) :: vtkroot - INTEGER(IntKi) :: iWT - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SetVTKParameters' - real(SiKi) :: BladeLength, MaxBladeLength, MaxTwrLength, GroundRad + type(ADI_Data), target, intent(in ) :: ADI ! Input data for initialization (intent out for getting AD WriteOutput names/units) + integer(IntKi), intent( out) :: errStat !< Error status of the operation + character(*), intent( out) :: errMsg !< Error message if errStat /= ErrID_None + real(SiKi) :: RefPoint(3), RefLengths(2) + real(SiKi) :: x, y + real(SiKi) :: TwrDiam_top, TwrDiam_base, TwrRatio, TwrLength + integer(IntKi) :: topNode, baseNode, cylNode, tipNode, rootNode + integer(IntKi) :: NumBl, k, iRot, iBld, nNodes + character(1024) :: vtkroot + integer(IntKi) :: iWT + integer(IntKi) :: errStat2 + character(ErrMsgLen) :: errMsg2 + character(*), parameter :: RoutineName = 'SetVTKParameters' + real(SiKi) :: BladeLength, MaxBladeLength, MaxTwrLength, GroundRad, MaxLength real(SiKi) :: WorldBoxMax(3), WorldBoxMin(3) ! Extent of the turbines real(SiKi) :: BaseBoxDim type(MeshType), pointer :: Mesh type(WTData), pointer :: wt ! Alias to shorten notation - ErrStat = ErrID_None - ErrMsg = "" + errStat = ErrID_None + errMsg = "" + ! --- Tower Blades (NOTE: done by ADI) + !call AD_SetVTKSurface(InitOut_AD, u%AD, m%VTK_Surfaces, errStat2, errMsg2); if(Failed()) return + ! get the name of the output directory for vtk files (in a subdirectory called "vtk" of the output directory), and ! create the VTK directory if it does not exist call GetPath ( p_FAST%root, p_FAST%VTK_OutFileRoot, vtkroot ) ! the returned p_FAST%VTK_OutFileRoot includes a file separator character at the end @@ -2139,33 +1806,42 @@ SUBROUTINE SetVTKParameters(p_FAST, dvr, InitOutData_AD, AD, ErrStat, ErrMsg) allocate(p_FAST%VTK_Surface(dvr%numTurbines)) ! --- Find dimensions for all objects to determine "Ground" and typical dimensions - WorldBoxMax =-HUGE(1.0_SiKi) - WorldBoxMin = HUGE(1.0_SiKi) - MaxBladeLength=0 - MaxTwrLength=0 + MaxBladeLength = 0 + MaxTwrLength = 0 + MaxLength = 0 do iWT=1,dvr%numTurbines wt => dvr%wt(iWT) do iBld=1, wt%numBlades - nNodes = AD%u(1)%rotors(iWT)%BladeMotion(iBld)%nnodes - BladeLength = TwoNorm(AD%u(1)%rotors(iWT)%BladeMotion(iBld)%Position(:,nNodes)-AD%u(1)%rotors(iWT)%BladeMotion(iBld)%Position(:,1)) + nNodes = ADI%u(1)%AD%rotors(iWT)%BladeMotion(iBld)%nnodes + BladeLength = TwoNorm(ADI%u(1)%AD%rotors(iWT)%BladeMotion(iBld)%Position(:,nNodes)-ADI%u(1)%AD%rotors(iWT)%BladeMotion(iBld)%Position(:,1)) MaxBladeLength = max(MaxBladeLength, BladeLength) enddo if (wt%hasTower) then - Mesh=>AD%u(1)%rotors(iWT)%TowerMotion + Mesh=>ADI%u(1)%AD%rotors(iWT)%TowerMotion if (Mesh%NNodes>0) then TwrLength = TwoNorm( Mesh%position(:,1) - Mesh%position(:,Mesh%NNodes) ) MaxTwrLength = max(MaxTwrLength, TwrLength) endif endif + MaxLength = max(MaxLength, MaxTwrLength, MaxBladeLength) ! Determine extent of the objects RefPoint = wt%originInit - WorldBoxMax(1) = max(WorldBoxMax(1), RefPoint(1)) - WorldBoxMax(2) = max(WorldBoxMax(2), RefPoint(2)) - WorldBoxMax(3) = max(WorldBoxMax(3), RefPoint(3)) ! NOTE: not used - WorldBoxMin(1) = min(WorldBoxMin(1), RefPoint(1)) - WorldBoxMin(2) = min(WorldBoxMin(2), RefPoint(2)) - WorldBoxMin(3) = min(WorldBoxMin(3), RefPoint(3)) ! NOTE: not used + if (iWT==1) then + WorldBoxMax(1) = RefPoint(1)+MaxLength + WorldBoxMax(2) = RefPoint(2)+MaxLength + WorldBoxMax(3) = RefPoint(3)+MaxLength ! NOTE: not used + WorldBoxMin(1) = RefPoint(1)-MaxLength + WorldBoxMin(2) = RefPoint(2)-MaxLength + WorldBoxMin(3) = RefPoint(3)-MaxLength ! NOTE: not used + else + WorldBoxMax(1) = max(WorldBoxMax(1), RefPoint(1)+MaxLength) + WorldBoxMax(2) = max(WorldBoxMax(2), RefPoint(2)+MaxLength) + WorldBoxMax(3) = max(WorldBoxMax(3), RefPoint(3)+MaxLength) ! NOTE: not used + WorldBoxMin(1) = min(WorldBoxMin(1), RefPoint(1)-MaxLength) + WorldBoxMin(2) = min(WorldBoxMin(2), RefPoint(2)-MaxLength) + WorldBoxMin(3) = min(WorldBoxMin(3), RefPoint(3)-MaxLength) ! NOTE: not used + endif enddo ! Loop on turbine ! Get radius for ground (blade length + hub radius): @@ -2179,7 +1855,8 @@ SUBROUTINE SetVTKParameters(p_FAST, dvr, InitOutData_AD, AD, ErrStat, ErrMsg) RefPoint(3) = 0.0_ReKi RefLengths = GroundRad + sqrt((WorldBoxMax(1)-WorldBoxMin(1))**2 + (WorldBoxMax(2)-WorldBoxMin(2))**2) - call WrVTK_Ground (RefPoint, RefLengths, trim(p_FAST%VTK_OutFileRoot) // '.GroundSurface', ErrStat2, ErrMsg2 ) + call WrVTK_Ground (RefPoint, RefLengths, trim(p_FAST%VTK_OutFileRoot) // '.GroundSurface', errStat2, errMsg2 ) + ! --- Create surfaces for Nacelle, Base, Tower, Blades do iWT=1,dvr%numTurbines @@ -2196,36 +1873,11 @@ SUBROUTINE SetVTKParameters(p_FAST, dvr, InitOutData_AD, AD, ErrStat, ErrMsg) p_FAST%VTK_Surface(iWT)%NacelleBox(:,7) = (/ p_FAST%VTKNacDim(1)+p_FAST%VTKNacDim(4), p_FAST%VTKNacDim(2)+p_FAST%VTKNacDim(5), p_FAST%VTKNacDim(3)+p_FAST%VTKNacDim(6) /) p_FAST%VTK_Surface(iWT)%NacelleBox(:,8) = (/ p_FAST%VTKNacDim(1) , p_FAST%VTKNacDim(2)+p_FAST%VTKNacDim(5), p_FAST%VTKNacDim(3)+p_FAST%VTKNacDim(6) /) - !....................... - ! tapered tower - !....................... + ! Create base box (using towerbase or nacelle dime) BaseBoxDim = minval(p_FAST%VTKNacDim(4:6))/2 - if (wt%hasTower) then - Mesh=>AD%u(1)%rotors(iWT)%TowerMotion - if (Mesh%NNodes>0) then - CALL AllocAry(p_FAST%VTK_Surface(iWT)%TowerRad, Mesh%NNodes,'VTK_Surface(iWT)%TowerRad',ErrStat2,ErrMsg2) - topNode = Mesh%NNodes - 1 - !baseNode = Mesh%refNode - baseNode = 1 ! TODO TODO - TwrLength = TwoNorm( Mesh%position(:,topNode) - Mesh%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,Mesh%NNodes - TwrLength = TwoNorm( Mesh%position(:,k) - Mesh%position(:,baseNode) ) - p_FAST%VTK_Surface(iWT)%TowerRad(k) = 0.5*TwrDiam_Base + TwrRatio*TwrLength - end do - BaseBoxDim = TwrDiam_Base/2 - else - print*,'>>>> TOWER HAS NO NODES' - !CALL AllocAry(p_FAST%VTK_Surface(iWT)%TowerRad, 2, 'VTK_Surface(iWT)%TowerRad',ErrStat2,ErrMsg2) - ! TODO create a fake tower - endif + if (size(ADI%m%VTK_Surfaces(iWT)%TowerRad)>0) then + BaseBoxDim = ADI%m%VTK_Surfaces(iWT)%TowerRad(1) endif - - ! Create base box (using towerbase or nacelle dime) p_FAST%VTK_Surface(iWT)%BaseBox(:,1) = (/ -BaseBoxDim , -BaseBoxDim+2*BaseBoxDim, -BaseBoxDim /) p_FAST%VTK_Surface(iWT)%BaseBox(:,2) = (/ -BaseBoxDim+2*BaseBoxDim, -BaseBoxDim+2*BaseBoxDim, -BaseBoxDim /) p_FAST%VTK_Surface(iWT)%BaseBox(:,3) = (/ -BaseBoxDim+2*BaseBoxDim, -BaseBoxDim , -BaseBoxDim /) @@ -2235,276 +1887,392 @@ SUBROUTINE SetVTKParameters(p_FAST, dvr, InitOutData_AD, AD, ErrStat, ErrMsg) p_FAST%VTK_Surface(iWT)%BaseBox(:,7) = (/ -BaseBoxDim+2*BaseBoxDim, -BaseBoxDim+2*BaseBoxDim, -BaseBoxDim+2*BaseBoxDim /) p_FAST%VTK_Surface(iWT)%BaseBox(:,8) = (/ -BaseBoxDim , -BaseBoxDim+2*BaseBoxDim, -BaseBoxDim+2*BaseBoxDim /) - !....................... - ! blade surfaces - !....................... - allocate(p_FAST%VTK_Surface(iWT)%BladeShape(wt%numBlades),stat=ErrStat2) - IF (ALLOCATED(InitOutData_AD%rotors(iWT)%BladeShape)) THEN - do k=1,wt%numBlades - call move_alloc( InitOutData_AD%rotors(iWT)%BladeShape(k)%AirfoilCoords, p_FAST%VTK_Surface(iWT)%BladeShape(k)%AirfoilCoords ) - end do - else - print*,'>>> Profile coordinates missing, using dummy coordinates' - rootNode = 1 - DO K=1,wt%numBlades - tipNode = AD%u(1)%rotors(iWT)%BladeMotion(K)%NNodes - cylNode = min(3,AD%u(1)%rotors(iWT)%BladeMotion(K)%Nnodes) - - call SetVTKDefaultBladeParams(AD%u(1)%rotors(iWT)%BladeMotion(K), p_FAST%VTK_Surface(iWT)%BladeShape(K), tipNode, rootNode, cylNode, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - END DO - endif enddo ! iWT, turbines -END SUBROUTINE SetVTKParameters +end subroutine SetVTKParameters !---------------------------------------------------------------------------------------------------------------------------------- !> This routine writes a minimal subset of meshes with surfaces to VTK-formatted files. It doesn't bother with !! returning an error code. -SUBROUTINE WrVTK_Surfaces(t_global, dvr, p_FAST, VTK_count, AD) +subroutine WrVTK_Surfaces(t_global, ADI, FED, p_FAST, VTK_count) use FVW_IO, only: WrVTK_FVW - - REAL(DbKi), INTENT(IN ) :: t_global !< Current global time - type(Dvr_SimData), target, intent(inout) :: dvr ! intent(out) only so that we can save FmtWidth in dvr%out%ActualChanLen - TYPE(Dvr_Outputs), INTENT(IN ) :: p_FAST !< Parameters for the glue code - INTEGER(IntKi) , INTENT(IN ) :: VTK_count - TYPE(AeroDyn_Data), INTENT(IN ) :: AD !< AeroDyn data - logical, parameter :: OutputFields = .FALSE. ! due to confusion about what fields mean on a surface, we are going to just output the basic meshes if people ask for fields - INTEGER(IntKi) :: k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMSg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WrVTK_Surfaces' - integer(IntKi) :: iWT - type(WTData), pointer :: wt ! Alias to shorten notation - character(10) :: sWT - - ! Ground (written at initialization) - - do iWT = 1, size(dvr%WT) - sWT = '.T'//trim(num2lstr(iWT)) - wt=>dvr%WT(iWT) + real(DbKi), intent(in ) :: t_global !< Current global time + type(FED_Data), target, intent(in ) :: FED !< Elastic wind turbine data (Fake ElastoDyn) + type(ADI_Data), intent(in ) :: ADI !< Input data for initialization (intent out for getting AD WriteOutput names/units) + type(Dvr_Outputs), intent(in ) :: p_FAST !< Parameters for the glue code + integer(IntKi) , intent(in ) :: VTK_count + logical, parameter :: OutputFields = .FALSE. ! due to confusion about what fields mean on a surface, we are going to just output the basic meshes if people ask for fields + integer(IntKi) :: errStat2 + character(ErrMsgLen) :: errMSg2 + integer(IntKi) :: iWT + integer(IntKi) :: nWT + character(10) :: sWT + type(RotFED), pointer :: y_ED ! Alias to shorten notation + + ! AeroDyn surfaces (Blades, Hub, Tower) + call AD_WrVTK_Surfaces(ADI%u(2)%AD, ADI%y%AD, p_FAST%VTKRefPoint, ADI%m%VTK_Surfaces, VTK_count, p_FAST%VTK_OutFileRoot, p_FAST%VTK_tWidth, 25, p_FAST%VTKHubRad) + + ! Elastic info + nWT = size(FED%WT) + do iWT = 1, nWT + if (nWT==1) then + sWT = '' + else + sWT = '.T'//trim(num2lstr(iWT)) + endif + y_ED => FED%WT(iWT) ! Base - call MeshWrVTK_PointSurface (p_FAST%VTKRefPoint, wt%ptMesh, trim(p_FAST%VTK_OutFileRoot)//trim(sWT)//'.BaseSurface', & - VTK_count, OutputFields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth , verts = p_FAST%VTK_Surface(iWT)%BaseBox) - - ! Tower motions - if (AD%u(2)%rotors(iWT)%TowerMotion%nNodes>0) then - call MeshWrVTK_Ln2Surface (p_FAST%VTKRefPoint, AD%u(2)%rotors(iWT)%TowerMotion, trim(p_FAST%VTK_OutFileRoot)//trim(sWT)//'.TowerSurface', & - VTK_count, OutputFields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, p_FAST%VTK_Surface(iWT)%NumSectors, p_FAST%VTK_Surface(iWT)%TowerRad ) - endif - - if (wt%numBlades>0) then + call MeshWrVTK_PointSurface (p_FAST%VTKRefPoint, y_ED%PlatformPtMesh, trim(p_FAST%VTK_OutFileRoot)//trim(sWT)//'.BaseSurface', & + VTK_count, OutputFields, errStat2, errMsg2, p_FAST%VTK_tWidth , verts = p_FAST%VTK_Surface(iWT)%BaseBox) + if (y_ED%numBlades>0) then ! Nacelle - call MeshWrVTK_PointSurface (p_FAST%VTKRefPoint, wt%nac%ptMesh, trim(p_FAST%VTK_OutFileRoot)//trim(sWT)//'.NacelleSurface', & - VTK_count, OutputFields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth , verts = p_FAST%VTK_Surface(iWT)%NacelleBox) - - ! Hub - call MeshWrVTK_PointSurface (p_FAST%VTKRefPoint, AD%u(2)%rotors(iWT)%HubMotion, trim(p_FAST%VTK_OutFileRoot)//trim(sWT)//'.HubSurface', & - VTK_count, OutputFields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth , & - NumSegments=p_FAST%VTK_Surface(iWT)%NumSectors, radius=p_FAST%VTKHubRad) + call MeshWrVTK_PointSurface (p_FAST%VTKRefPoint, y_ED%NacelleMotion, trim(p_FAST%VTK_OutFileRoot)//trim(sWT)//'.NacelleSurface', & + VTK_count, OutputFields, errStat2, errMsg2, p_FAST%VTK_tWidth , verts = p_FAST%VTK_Surface(iWT)%NacelleBox) endif - - ! Blades - do K=1,wt%numBlades - - call MeshWrVTK_Ln2Surface (p_FAST%VTKRefPoint, AD%u(2)%rotors(iWT)%BladeMotion(K), trim(p_FAST%VTK_OutFileRoot)//trim(sWT)//'.Blade'//trim(num2lstr(k))//'Surface', & - VTK_count, OutputFields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth , verts=p_FAST%VTK_Surface(iWT)%BladeShape(K)%AirfoilCoords & - ,Sib=AD%y%rotors(iWT)%BladeLoad(k) ) - end do - if (p_FAST%WrVTK>1) then - ! --- animations + ! --- animations ! Tower base - call MeshWrVTK_PointSurface (p_FAST%VTKRefPoint, wt%twr%ptMesh, trim(p_FAST%VTK_OutFileRoot)//trim(sWT)//'.TwrBaseSurface', & - VTK_count, OutputFields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth , & + call MeshWrVTK_PointSurface (p_FAST%VTKRefPoint, y_ED%TwrPtMesh, trim(p_FAST%VTK_OutFileRoot)//trim(sWT)//'.TwrBaseSurface', & + VTK_count, OutputFields, errStat2, errMsg2, p_FAST%VTK_tWidth , & NumSegments=p_FAST%VTK_Surface(iWT)%NumSectors, radius=p_FAST%VTKHubRad) - if (AD%u(2)%rotors(iWT)%TowerMotion%nNodes>0) then - call MeshWrVTK_PointSurface (p_FAST%VTKRefPoint, wt%twr%ptMeshAD, trim(p_FAST%VTK_OutFileRoot)//trim(sWT)//'.TwrBaseSurfaceAD', & - VTK_count, OutputFields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth , & + if (ADI%u(2)%AD%rotors(iWT)%TowerMotion%nNodes>0) then + call MeshWrVTK_PointSurface (p_FAST%VTKRefPoint, y_ED%TwrPtMeshAD, trim(p_FAST%VTK_OutFileRoot)//trim(sWT)//'.TwrBaseSurfaceAD', & + VTK_count, OutputFields, errStat2, errMsg2, p_FAST%VTK_tWidth , & NumSegments=p_FAST%VTK_Surface(iWT)%NumSectors, radius=p_FAST%VTKHubRad) endif - endif enddo - ! Free wake - if (allocated(AD%m%FVW_u)) then - if (allocated(AD%m%FVW_u(1)%WingsMesh)) then - call WrVTK_FVW(AD%p%FVW, AD%x%FVW, AD%z%FVW, AD%m%FVW, trim(p_FAST%VTK_OutFileRoot)//'.FVW', VTK_count, p_FAST%VTK_tWidth, bladeFrame=.FALSE.) ! bladeFrame==.FALSE. to output in global coords + if (allocated(ADI%m%AD%FVW_u)) then + if (allocated(ADI%m%AD%FVW_u(1)%WingsMesh)) then + call WrVTK_FVW(ADI%p%AD%FVW, ADI%x%AD%FVW, ADI%z%AD%FVW, ADI%m%AD%FVW, trim(p_FAST%VTK_OutFileRoot)//'.FVW', VTK_count, p_FAST%VTK_tWidth, bladeFrame=.FALSE.) ! bladeFrame==.FALSE. to output in global coords end if end if -END SUBROUTINE WrVTK_Surfaces -!---------------------------------------------------------------------------------------------------------------------------------- +end subroutine WrVTK_Surfaces !> This routine writes a minimal subset of meshes with surfaces to VTK-formatted files. It doesn't bother with !! returning an error code. -SUBROUTINE WrVTK_Lines(t_global, dvr, p_FAST, VTK_count, AD) +subroutine WrVTK_Lines(t_global, ADI, FED, p_FAST, VTK_count) use FVW_IO, only: WrVTK_FVW REAL(DbKi), INTENT(IN ) :: t_global !< Current global time - type(Dvr_SimData), target, intent(inout) :: dvr ! intent(out) only so that we can save FmtWidth in dvr%out%ActualChanLen - TYPE(Dvr_Outputs), INTENT(IN ) :: p_FAST !< Parameters for the glue code + type(ADI_Data), intent(in ) :: ADI !< Input data for initialization (intent out for getting AD WriteOutput names/units) + type(FED_Data), target, intent(in ) :: FED !< Elastic wind turbine data (Fake ElastoDyn) + TYPE(Dvr_Outputs), INTENT(IN ) :: p_FAST !< Parameters for the glue code INTEGER(IntKi) , INTENT(IN ) :: VTK_count - TYPE(AeroDyn_Data), INTENT(IN ) :: AD !< AeroDyn data - logical, parameter :: OutputFields = .FALSE. ! due to confusion about what fields mean on a surface, we are going to just output the basic meshes if people ask for fields - INTEGER(IntKi) :: k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMSg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WrVTK_Lines' - integer(IntKi) :: iWT - type(WTData), pointer :: wt ! Alias to shorten notation - character(10) :: sWT - - do iWT = 1, size(dvr%WT) - sWT = '.T'//trim(num2lstr(iWT)) - wt=>dvr%WT(iWT) - - ! Tower motions - if (AD%u(2)%rotors(iWT)%TowerMotion%nNodes>0) then - call MeshWrVTK(p_FAST%VTKRefPoint, AD%u(2)%rotors(iWT)%TowerMotion, trim(p_FAST%VTK_OutFileRoot)//trim(sWT)//'.Tower', & - VTK_count, OutputFields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) + logical, parameter :: OutputFields = .TRUE. + INTEGER(IntKi) :: k + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMSg2 + integer(IntKi) :: iWT + integer(IntKi) :: nWT + character(10) :: sWT + type(RotFED), pointer :: y_ED ! Alias to shorten notation + + ! AeroDyn surfaces (Blades, Tower) + call AD_WrVTK_LinesPoints(ADI%u(2)%AD, ADI%y%AD, p_FAST%VTKRefPoint, VTK_count, p_FAST%VTK_OutFileRoot, p_FAST%VTK_tWidth) + + ! Elastic info + nWT = size(FED%WT) + do iWT = 1, nWT + if (nWT==1) then + sWT = '' + else + sWT = '.T'//trim(num2lstr(iWT)) endif + y_ED => FED%WT(iWT) - if (wt%numBlades>0) then + if (p_FAST%WrVTK_Type==2) then ! only if not doing surfaces + ! Base + call MeshWrVTK_PointSurface (p_FAST%VTKRefPoint, y_ED%PlatformPtMesh, trim(p_FAST%VTK_OutFileRoot)//trim(sWT)//'.BaseSurface', & + VTK_count, OutputFields, errStat2, errMsg2, p_FAST%VTK_tWidth , verts = p_FAST%VTK_Surface(iWT)%BaseBox) + endif + if (y_ED%numBlades>0) then ! Nacelle - call MeshWrVTK(p_FAST%VTKRefPoint, wt%nac%ptMesh, trim(p_FAST%VTK_OutFileRoot)//trim(sWT)//'.Nacelle', & - VTK_count, OutputFields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) - - ! Hub - call MeshWrVTK(p_FAST%VTKRefPoint, AD%u(2)%rotors(iWT)%HubMotion, trim(p_FAST%VTK_OutFileRoot)//trim(sWT)//'.Hub', & - VTK_count, OutputFields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) + call MeshWrVTK( p_FAST%VTKRefPoint, y_ED%NacelleMotion, trim(p_FAST%VTK_OutFileRoot)//trim(sWT)//'.Nacelle', & + VTK_count, OutputFields, errStat2, errMsg2, p_FAST%VTK_tWidth ) endif - ! Blades - do K=1,wt%numBlades - call MeshWrVTK(p_FAST%VTKRefPoint, AD%u(2)%rotors(iWT)%BladeMotion(K), trim(p_FAST%VTK_OutFileRoot)//trim(sWT)//'.Blade'//trim(num2lstr(k)), & - VTK_count, OutputFields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, Sib=AD%y%rotors(iWT)%BladeLoad(k) ) - end do + if (p_FAST%WrVTK>1) then + ! --- animations + ! Tower base + call MeshWrVTK(p_FAST%VTKRefPoint, y_ED%TwrPtMesh, trim(p_FAST%VTK_OutFileRoot)//trim(sWT)//'.TwrBase', & + VTK_count, OutputFields, errStat2, errMsg2, p_FAST%VTK_tWidth ) + + if (ADI%u(2)%AD%rotors(iWT)%TowerMotion%nNodes>0) then + call MeshWrVTK(p_FAST%VTKRefPoint, y_ED%TwrPtMeshAD, trim(p_FAST%VTK_OutFileRoot)//trim(sWT)//'.TwrBaseAD', & + VTK_count, OutputFields, errStat2, errMsg2, p_FAST%VTK_tWidth ) + endif + endif enddo ! Free wake (only write this here if doing line meshes only -- FVW is written with surface outputs) - if (allocated(AD%m%FVW_u) .and. dvr%out%WrVTK_Type==2) then - if (allocated(AD%m%FVW_u(1)%WingsMesh)) then - call WrVTK_FVW(AD%p%FVW, AD%x%FVW, AD%z%FVW, AD%m%FVW, trim(p_FAST%VTK_OutFileRoot)//'.FVW', VTK_count, p_FAST%VTK_tWidth, bladeFrame=.FALSE.) ! bladeFrame==.FALSE. to output in global coords + if (allocated(ADI%m%AD%FVW_u) .and. p_FAST%WrVTK_Type==2) then + if (allocated(ADI%m%AD%FVW_u(1)%WingsMesh)) then + call WrVTK_FVW(ADI%p%AD%FVW, ADI%x%AD%FVW, ADI%z%AD%FVW, ADI%m%AD%FVW, trim(p_FAST%VTK_OutFileRoot)//'.FVW', VTK_count, p_FAST%VTK_tWidth, bladeFrame=.FALSE.) ! bladeFrame==.FALSE. to output in global coords end if end if -END SUBROUTINE WrVTK_Lines +end subroutine WrVTK_Lines !---------------------------------------------------------------------------------------------------------------------------------- !> This routine writes the ground or seabed reference surface information in VTK format. !! see VTK file information format for XML, here: http://www.vtk.org/wp-content/uploads/2015/04/file-formats.pdf -SUBROUTINE WrVTK_Ground ( RefPoint, HalfLengths, FileRootName, ErrStat, ErrMsg ) +subroutine WrVTK_Ground (RefPoint, HalfLengths, FileRootName, errStat, errMsg) REAL(SiKi), INTENT(IN) :: RefPoint(3) !< reference point (plane will be created around it) REAL(SiKi), INTENT(IN) :: HalfLengths(2) !< half of the X-Y lengths of plane surrounding RefPoint CHARACTER(*), INTENT(IN) :: FileRootName !< Name of the file to write the output in (excluding extension) - INTEGER(IntKi), INTENT(OUT) :: ErrStat !< Indicates whether an error occurred (see NWTC_Library) - CHARACTER(*), INTENT(OUT) :: ErrMsg !< Error message associated with the ErrStat + INTEGER(IntKi), INTENT(OUT) :: errStat !< Indicates whether an error occurred (see NWTC_Library) + CHARACTER(*), INTENT(OUT) :: errMsg !< Error message associated with the errStat ! local variables - INTEGER(IntKi) :: Un ! fortran unit number - INTEGER(IntKi) :: ix ! loop counters - CHARACTER(1024) :: FileName - INTEGER(IntKi), parameter :: NumberOfPoints = 4 - INTEGER(IntKi), parameter :: NumberOfLines = 0 - INTEGER(IntKi), parameter :: NumberOfPolys = 1 - - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*),PARAMETER :: RoutineName = 'WrVTK_Ground' - ErrStat = ErrID_None - ErrMsg = "" - !................................................................. - ! write the data that potentially changes each time step: - !................................................................. - ! PolyData (.vtp) - Serial vtkPolyData (unstructured) file + INTEGER(IntKi) :: Un ! fortran unit number + INTEGER(IntKi) :: ix ! loop counters + CHARACTER(1024) :: FileName + INTEGER(IntKi), parameter :: NumberOfPoints = 4 + INTEGER(IntKi), parameter :: NumberOfLines = 0 + INTEGER(IntKi), parameter :: NumberOfPolys = 1 + INTEGER(IntKi) :: errStat2 + CHARACTER(ErrMsgLen) :: errMsg2 + errStat = ErrID_None + errMsg = "" FileName = TRIM(FileRootName)//'.vtp' - call WrVTK_header( FileName, NumberOfPoints, NumberOfLines, NumberOfPolys, Un, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat >= AbortErrLev) return -! points (nodes, augmented with NumSegments): - WRITE(Un,'(A)') ' ' - WRITE(Un,'(A)') ' ' - WRITE(Un,VTK_AryFmt) RefPoint(1) + HalfLengths(1) , RefPoint(2) + HalfLengths(2), RefPoint(3) - WRITE(Un,VTK_AryFmt) RefPoint(1) + HalfLengths(1) , RefPoint(2) - HalfLengths(2), RefPoint(3) - WRITE(Un,VTK_AryFmt) RefPoint(1) - HalfLengths(1) , RefPoint(2) - HalfLengths(2), RefPoint(3) - WRITE(Un,VTK_AryFmt) RefPoint(1) - HalfLengths(1) , RefPoint(2) + HalfLengths(2), RefPoint(3) - WRITE(Un,'(A)') ' ' - WRITE(Un,'(A)') ' ' - WRITE(Un,'(A)') ' ' - WRITE(Un,'(A)') ' ' - WRITE(Un,'('//trim(num2lstr(NumberOfPoints))//'(i7))') (ix, ix=0,NumberOfPoints-1) - WRITE(Un,'(A)') ' ' - - WRITE(Un,'(A)') ' ' - WRITE(Un,'(i7)') NumberOfPoints - WRITE(Un,'(A)') ' ' - WRITE(Un,'(A)') ' ' - call WrVTK_footer( Un ) -END SUBROUTINE WrVTK_Ground + call WrVTK_header( FileName, NumberOfPoints, NumberOfLines, NumberOfPolys, Un, errStat2, errMsg2 ) + call SetErrStat(errStat2,errMsg2,errStat,errMsg,'WrVTK_Ground'); if (errStat >= AbortErrLev) return + WRITE(Un,'(A)') ' ' + WRITE(Un,'(A)') ' ' + WRITE(Un,VTK_AryFmt) RefPoint(1) + HalfLengths(1) , RefPoint(2) + HalfLengths(2), RefPoint(3) + WRITE(Un,VTK_AryFmt) RefPoint(1) + HalfLengths(1) , RefPoint(2) - HalfLengths(2), RefPoint(3) + WRITE(Un,VTK_AryFmt) RefPoint(1) - HalfLengths(1) , RefPoint(2) - HalfLengths(2), RefPoint(3) + WRITE(Un,VTK_AryFmt) RefPoint(1) - HalfLengths(1) , RefPoint(2) + HalfLengths(2), RefPoint(3) + WRITE(Un,'(A)') ' ' + WRITE(Un,'(A)') ' ' + WRITE(Un,'(A)') ' ' + WRITE(Un,'(A)') ' ' + WRITE(Un,'('//trim(num2lstr(NumberOfPoints))//'(i7))') (ix, ix=0,NumberOfPoints-1) + WRITE(Un,'(A)') ' ' + + WRITE(Un,'(A)') ' ' + WRITE(Un,'(i7)') NumberOfPoints + WRITE(Un,'(A)') ' ' + WRITE(Un,'(A)') ' ' + call WrVTK_footer( Un ) +end subroutine WrVTK_Ground !---------------------------------------------------------------------------------------------------------------------------------- -!> This subroutine comes up with some default airfoils for blade surfaces for a given blade mesh, M. -SUBROUTINE SetVTKDefaultBladeParams(M, BladeShape, tipNode, rootNode, cylNode, ErrStat, ErrMsg) - TYPE(MeshType), INTENT(IN ) :: M !< The Mesh the defaults should be calculated for - TYPE(DvrVTK_BLSurfaceType), INTENT(INOUT) :: BladeShape !< BladeShape to set to default values - INTEGER(IntKi), INTENT(IN ) :: rootNode !< Index of root node (innermost node) for this mesh - INTEGER(IntKi), INTENT(IN ) :: tipNode !< Index of tip node (outermost node) for this mesh - INTEGER(IntKi), INTENT(IN ) :: cylNode !< Index of last node to have a cylinder shape - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - REAL(SiKi) :: bladeLength, chord, pitchAxis - REAL(SiKi) :: bladeLengthFract, bladeLengthFract2, ratio, posLength ! temporary quantities - REAL(SiKi) :: cylinderLength, x, y, angle - INTEGER(IntKi) :: i, j - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SetVTKDefaultBladeParams' - integer, parameter :: N = 66 - ! default airfoil shape coordinates; uses S809 values from http://wind.nrel.gov/airfoils/Shapes/S809_Shape.html: - real, parameter, dimension(N) :: xc=(/ 1.0,0.996203,0.98519,0.967844,0.945073,0.917488,0.885293,0.848455,0.80747,0.763042,0.715952,0.667064,0.617331,0.56783,0.519832,0.474243,0.428461,0.382612,0.33726,0.29297,0.250247,0.209576,0.171409,0.136174,0.104263,0.076035,0.051823,0.03191,0.01659,0.006026,0.000658,0.000204,0.0,0.000213,0.001045,0.001208,0.002398,0.009313,0.02323,0.04232,0.065877,0.093426,0.124111,0.157653,0.193738,0.231914,0.271438,0.311968,0.35337,0.395329,0.438273,0.48192,0.527928,0.576211,0.626092,0.676744,0.727211,0.776432,0.823285,0.86663,0.905365,0.938474,0.965086,0.984478,0.996141,1.0 /) - real, parameter, dimension(N) :: yc=(/ 0.0,0.000487,0.002373,0.00596,0.011024,0.017033,0.023458,0.03028,0.037766,0.045974,0.054872,0.064353,0.074214,0.084095,0.093268,0.099392,0.10176,0.10184,0.10007,0.096703,0.091908,0.085851,0.078687,0.07058,0.061697,0.052224,0.042352,0.032299,0.02229,0.012615,0.003723,0.001942,-0.00002,-0.001794,-0.003477,-0.003724,-0.005266,-0.011499,-0.020399,-0.030269,-0.040821,-0.051923,-0.063082,-0.07373,-0.083567,-0.092442,-0.099905,-0.105281,-0.108181,-0.108011,-0.104552,-0.097347,-0.086571,-0.073979,-0.060644,-0.047441,-0.0351,-0.024204,-0.015163,-0.008204,-0.003363,-0.000487,0.000743,0.000775,0.00029,0.0 /) - call AllocAry(BladeShape%AirfoilCoords, 2, N, M%NNodes, 'BladeShape%AirfoilCoords', ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - ! Chord length and pitch axis location are given by scaling law - bladeLength = TwoNorm( M%position(:,tipNode) - M%Position(:,rootNode) ) - cylinderLength = TwoNorm( M%Position(:,cylNode) - M%Position(:,rootNode) ) - bladeLengthFract = 0.22*bladeLength - bladeLengthFract2 = bladeLength-bladeLengthFract != 0.78*bladeLength - DO i=1,M%Nnodes - posLength = TwoNorm( M%Position(:,i) - M%Position(:,rootNode) ) - IF (posLength .LE. bladeLengthFract) THEN - ratio = posLength/bladeLengthFract - chord = (0.06 + 0.02*ratio)*bladeLength - pitchAxis = 0.25 + 0.125*ratio - ELSE - chord = (0.08 - 0.06*(posLength-bladeLengthFract)/bladeLengthFract2)*bladeLength - pitchAxis = 0.375 - END IF - IF (posLength .LE. cylinderLength) THEN - ! create a cylinder for this node - chord = chord/2.0_SiKi - DO j=1,N - ! normalized x,y coordinates for airfoil - x = yc(j) - y = xc(j) - 0.5 - angle = ATAN2( y, x) - ! x,y coordinates for cylinder - BladeShape%AirfoilCoords(1,j,i) = chord*COS(angle) ! x (note that "chord" is really representing chord/2 here) - BladeShape%AirfoilCoords(2,j,i) = chord*SIN(angle) ! y (note that "chord" is really representing chord/2 here) - END DO - ELSE - ! create an airfoil for this node - DO j=1,N - ! normalized x,y coordinates for airfoil, assuming an upwind turbine - x = yc(j) - y = xc(j) - pitchAxis - ! x,y coordinates for airfoil - BladeShape%AirfoilCoords(1,j,i) = chord*x - BladeShape%AirfoilCoords(2,j,i) = chord*y - END DO - END IF - END DO ! nodes on mesh - -END SUBROUTINE SetVTKDefaultBladeParams +!> User routine to initialize swap array for hub motion +subroutine userHubMotion_Init(userSwapAry, userSwapHdr, userSwapUnt, errStat, errMsg) + real(ReKi) , dimension(:), allocatable, intent(inout) :: userSwapAry !< user Swap Array + character(len=ChanLen) , dimension(:), allocatable, intent(inout) :: userSwapHdr !< Array of headers for user Swap Array + character(len=ChanLen) , dimension(:), allocatable, intent(inout) :: userSwapUnt !< Array of units for user Swap Array + integer(IntKi), intent(inout) :: errStat !< Status of error message + character(*), intent(inout) :: errMsg !< Error message if errStat /= ErrID_None + integer(IntKi) :: i ! loop index + integer(IntKi) :: errStat2 ! local status of error message + character(ErrMsgLen) :: errMsg2 ! local error message if errStat /= ErrID_None + integer, parameter :: SWAP_ARRAY_SIZE = 16 + errStat = ErrID_None + errMsg = '' + + call AllocAry(userSwapAry, SWAP_ARRAY_SIZE, 'userSwapAry', errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, 'userHubMotion_Init') + call AllocAry(userSwapHdr, SWAP_ARRAY_SIZE, 'userSwapHdr', errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, 'userHubMotion_Init') + call AllocAry(userSwapUnt, SWAP_ARRAY_SIZE, 'userSwapUnt', errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, 'userHubMotion_Init') + if (errStat/=ErrID_None) return + ! + userSwapAry(:) = 0.0_ReKi + userSwapUnt(:) = "(-)" + do i = 1, size(userSwapAry); userSwapHdr(i) = 'Swap'//trim(num2lstr(i)); enddo; + i = iAzi ; userSwapHdr(i) = "SwapAzimuth "; userSwapUnt(i) = "(deg) " ! 1 + i = iAzi+1 ; userSwapHdr(i) = "SwapRotSpeed "; userSwapUnt(i) = "(rad/s) " ! 2 + i = iAzi+2 ; userSwapHdr(i) = "SwapRotAcc "; userSwapUnt(i) = "(rad/s^2)" ! 3 + i = iN_ ; userSwapHdr(i) = "SwapTimeStep "; userSwapUnt(i) = "(-) " ! 4 + i = igenTorque ; userSwapHdr(i) = "SwapGenTq "; userSwapUnt(i) = "(Nm) " ! 5 + i = igenTorqueF ; userSwapHdr(i) = "SwapGenTqF "; userSwapUnt(i) = "(Nm) " ! 6 + i = irotTorque ; userSwapHdr(i) = "SwapRotTq "; userSwapUnt(i) = "(Nm) " ! 7 + i = irotTorqueF ; userSwapHdr(i) = "SwapRotTqF "; userSwapUnt(i) = "(Nm) " ! 8 + i = iDeltaTorque ; userSwapHdr(i) = "SwapDeltaTq "; userSwapUnt(i) = "(Nm) " ! 9 + i = iDeltaTorqueF; userSwapHdr(i) = "SwapDeltaTqF "; userSwapUnt(i) = "(Nm) " ! 10 + i = irotSpeedI ; userSwapHdr(i) = "SwapRotSpeedI"; userSwapUnt(i) = "(rad/s) " ! 11 + i = irotSpeedF ; userSwapHdr(i) = "SwapRotSpeedF"; userSwapUnt(i) = "(rad/s) " ! 12 + i = iAlpha ; userSwapHdr(i) = "SwapAlpha "; userSwapUnt(i) = "(-) " ! 13 + i = iRegion ; userSwapHdr(i) = "SwapRegion "; userSwapUnt(i) = "(-) " ! 14 +end subroutine userHubMotion_Init +!---------------------------------------------------------------------------------------------------------------------------------- +!> User routine to set hub motion +subroutine userHubMotion(nt, iWT, dvr, ADI, FED, arr, azimuth, rotSpeed, rotAcc, errStat, errMsg) + use AeroDyn_IO, only: RtFldMxh + integer(IntKi) , intent(in ) :: nt !< time step number + integer(IntKi) , intent(in ) :: iWT !< Wind turbine index + type(Dvr_SimData), intent(in ) :: dvr !< Driver arr + type(ADI_Data), intent(in ) :: ADI !< AeroDyn/InflowWind arr + type(FED_Data), intent(in ) :: FED !< Elastic wind turbine arr (Fake ElastoDyn) + real(ReKi), dimension(:), allocatable, intent(inout) :: arr !< Swap array that user can use to store arr + real(ReKi), intent( out) :: azimuth !< [deg] + real(ReKi), intent( out) :: rotSpeed !< [rad/s] + real(ReKi), intent( out) :: rotAcc !< [rad/s^2] + integer(IntKi), intent(inout) :: errStat !< Status of error message + character(*), intent(inout) :: errMsg !< Error message if errStat /= ErrID_None + ! Main parameters to be adjusted + real(ReKi), parameter :: cutInSpeed = 0.10 !< [rad/s] + real(ReKi), parameter :: ratedSpeed = 1.00 !< [rad/s] + real(ReKi), parameter :: maxSpeed = 10 !< [rad/s] + real(ReKi), parameter :: minSpeed = 0.0 !< [rad/s] + real(ReKi), parameter :: genTorque_rated = 10.0e6 !< [rad/s] + real(ReKi), parameter :: genTorqueRate_max = 8.0e6 !< [Nm/s] Maximum torque rate + real(ReKi), parameter :: k2 = 1.0e7 !< Proportionality constant + real(ReKi), parameter :: rotInertia = 5.0e6 !< [kg m^2] + real(ReKi), parameter :: CornerFreqTq = 3.5 !< Corner frequency (-3dB point) for the low-pass filter, rad/s. + real(ReKi), parameter :: CornerFreqSpeed = 1.0 !< Corner frequency (-3dB point) for the low-pass filter, rad/s. + ! Local + real(ReKi) :: azimuth_prev, rotSpeed_prev, rotAcc_prev, rotSpeed_int, rotSpeed_filt, rotSpeed_filt_prev + real(ReKi) :: rotTorque, rotTorque_prev, rotTorque_filt, rotTorque_filt_prev + real(ReKi) :: genTorque, genTorque_prev, genTorque_filt, genTorque_filt_prev + real(ReKi) :: deltaTorque, deltaTorque_filt, deltaTorque_prev, deltaTorque_filt_prev + real(ReKi) :: genTorqueRate + real(DbKi) :: time, time_prev + integer(IntKi) :: nt_prev + integer(IntKi) :: region + real(ReKi) :: alphaTq ! coefficient for the low-pass filter for the generator torque + real(ReKi) :: alphaSpeed ! coefficient for the low-pass filter for the rotor speed + errStat = ErrID_None + errMsg = '' + + ! First call, allocate memory + if (.not.allocated(arr)) then + errStat=ErrID_Fatal + errMsg='Swap array should have already been allocated' + return + endif + if (nt==0) then ! the first time this function is called + arr = 0.0_ReKi + arr(iN_) = real(nt, ReKi) + arr(iAzi+1) = rotSpeed ! setting to initial rotor speed, rotSpeed = rotSpeedInit + endif + + ! Retrieve previous time step values + azimuth_prev = arr(iAzi+0) + rotSpeed_prev = arr(iAzi+1) + rotAcc_prev = arr(iAzi+2) + rotSpeed_filt_prev = arr(irotSpeedF) + rotTorque_prev = arr(irotTorque) + genTorque_prev = arr(igenTorque) + rotTorque_filt_prev = arr(irotTorqueF) + genTorque_filt_prev = arr(igenTorqueF) + deltaTorque_prev = arr(iDeltaTorque) + deltaTorque_filt_prev = arr(iDeltaTorqueF) + ! Example, accessing even older values + !rotSpeed_prev_prev = arr(15) + !azimuth_prev_prev = arr(16) + + nt_prev = int(arr(iN_), IntKi) + time_prev = dvr%dt * nt_prev + time = dvr%dt * nt + ! Return if time step is the same as previous time step + if (nt==nt_prev) then + azimuth = azimuth_prev + rotSpeed = rotSpeed_prev + rotAcc = rotAcc_prev + return + endif + ! --- Filter constant. alpha=0: use current value(no filter), alpha=1 use previous value + alphaTq = exp( (time_prev - time)*CornerFreqTq ) + alphaSpeed = exp( (time_prev - time)*CornerFreqSpeed ) + alphaTq = min(max(alphaTq, 0._ReKi), 1.0_ReKi) ! Bounding value + + ! --- Rotor torque + rotTorque = ADI%m%AD%rotors(iWT)%AllOuts( RtFldMxh ) + ! Optional filtering of input torque + rotTorque_filt = ( 1.0 - alphaTq )*rotTorque + alphaTq*rotTorque_filt_prev + + ! --- Generator torque + ! TODO insert better generator model here + if (rotSpeed_prev >= ratedSpeed) then + genTorque = genTorque_rated + region = 3 + elseif (rotSpeed_prev > cutInSpeed) then + genTorque = k2 * rotSpeed**2 + region = 2 + else + genTorque = 0 + region = 0 + endif + + ! Optional - saturate torque rate + if (genTorque>0) then + genTorqueRate = (genTorque - genTorque_prev)/dvr%dt + genTorqueRate = min( max( genTorqueRate, -genTorqueRate_max), genTorqueRate_max) + genTorque = genTorque_prev + genTorqueRate * dvr%dt + endif + + ! Optional filtering + genTorque_filt = ( 1.0 - alphaTq )*genTorque + alphaTq*genTorque_filt_prev + + + ! --- Delta torque + !deltaTorque = rotTorque_filt - genTorque_filt + !deltaTorque = rotTorque - genTorque + deltaTorque = rotTorque - genTorque + ! Optional filtering + deltaTorque_filt = ( 1.0 - alphaTq )*deltaTorque + alphaTq*deltaTorque_filt_prev + + ! --- Rotor Speed + rotSpeed_int = rotSpeed_prev + dvr%dt/rotInertia * (deltaTorque) + !rotSpeed_int = 6.0*2*PI/60 ! Constant speed hack + + ! Optional filtering of the rotor speed + rotSpeed_filt = ( 1.0 - alphaSpeed )*rotSpeed_int + alphaSpeed*rotSpeed_filt_prev ! filtered + + ! Chose rotational speed + !rotSpeed = rotSpeed_filt ! we return the filtered value + rotSpeed = rotSpeed_int ! we return the filtered value + + ! Bounding + rotSpeed = min(max(rotSpeed, minSpeed), maxSpeed) ! Bounding rotor speed + + ! --- Azimuth and acceleration + azimuth = azimuth_prev + (dvr%dt * rotSpeed)*180/PI ! [deg] + rotAcc = (rotSpeed-rotSpeed_prev) / dvr%dt ! Or set it to zero.. + !rotAcc = 0.0_ReKi + + ! --- Example, access other turbine information + ! NOTE: if the turbine index is higher than iWT, then the information is at "new time step" + ! if the turbine index is lower than iWT, then the information is at "old time step" + !if (iWT==2) then + ! ! OR use: + ! azimuth = dvr%WT(1)%hub%azimuth + ! rotSpeed = dvr%WT(1)%hub%rotSpeed + ! rotAcc = dvr%WT(1)%hub%rotAcc + ! ! -- If the turbine uses a swap array (user hub motion0, you can also access it here) + ! !azimuth = FED%WT(2)%userSwapArray(iAzi+0) + ! !rotSpeed = FED%WT(2)%userSwapArray(iAzi+1) + ! !rotAcc = FED%WT(2)%userSwapArray(iAzi+2) + !endif + + ! --- Example enforce initial velocity at few first time steps! + ! NOTE: first time step nt=1 + !if (nt<=30) then + ! rotSpeed = rotSpeed_prev + ! azimuth = modulo(REAL(dvr%dT*(nt-1)*rotSpeed, ReKi) * R2D, 360.0_ReKi ) + ! rotAcc = 0 + !endif + + + ! --- Store new values in swap array + arr(:) = myNaN + arr(iAzi+0) = azimuth + arr(iAzi+1) = rotSpeed + arr(iAzi+2) = rotAcc + arr(iN_) = nt + arr(igenTorque) = genTorque + arr(igenTorqueF) = genTorque_filt + arr(irotTorque) = rotTorque + arr(irotTorqueF) = rotTorque_filt + arr(iDeltaTorque) = deltaTorque + arr(iDeltaTorqueF) = deltaTorque_filt + arr(irotSpeedI ) = rotSpeed_int + arr(irotSpeedF ) = rotSpeed_filt + arr(iAlpha ) = alphaTq + arr(iRegion ) = region + ! --- Example store even older values + !arr(15) = rotSpeed_prev + !arr(16) = azimuth_prev +end subroutine userHubMotion end module AeroDyn_Driver_Subs diff --git a/modules/aerodyn/src/AeroDyn_Driver_Types.f90 b/modules/aerodyn/src/AeroDyn_Driver_Types.f90 index cdcee60a71..1969a57126 100644 --- a/modules/aerodyn/src/AeroDyn_Driver_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Driver_Types.f90 @@ -1,7953 +1,4761 @@ -!STARTOFREGISTRYGENERATEDFILE 'AeroDyn_Driver_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 -!********************************************************************************************************************************* -! AeroDyn_Driver_Types -!................................................................................................................................. -! This file is part of AeroDyn_Driver. -! -! 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 AeroDyn_Driver. It also contains copy, destroy, pack, and -!! unpack routines associated with each defined data type. This code is automatically generated by the FAST Registry. -MODULE AeroDyn_Driver_Types -!--------------------------------------------------------------------------------------------------------------------------------- -USE AeroDyn_Types -USE InflowWind_Types -USE NWTC_Library -IMPLICIT NONE - INTEGER(IntKi), PUBLIC, PARAMETER :: numInp = 2 ! Determines order of interpolation for input-output extrap (2=linear;3=quadratic) [-] -! ========= Dvr_Case ======= - TYPE, PUBLIC :: Dvr_Case - REAL(ReKi) :: HWindSpeed !< Hub wind speed [m/s] - REAL(ReKi) :: PLExp !< Power law wind-shear exponent [-] - REAL(ReKi) :: rotSpeed !< Rotor speed [rad/s] - REAL(ReKi) :: bldPitch !< Pitch angle [rad] - REAL(ReKi) :: nacYaw !< Yaw angle [rad] - REAL(DbKi) :: tMax !< Max time [s] - REAL(DbKi) :: dT !< time increment [s] - INTEGER(IntKi) :: numSteps !< number of steps in this case [-] - INTEGER(IntKi) :: DOF !< Degree of freedom for sinusoidal motion [-] - REAL(ReKi) :: amplitude !< Amplitude for sinusoidal motion (when DOF>0) [-] - REAL(ReKi) :: frequency !< Frequency for sinusoidal motion (when DOF>0) [-] - END TYPE Dvr_Case -! ======================= -! ========= DvrVTK_BLSurfaceType ======= - TYPE, PUBLIC :: DvrVTK_BLSurfaceType - REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: AirfoilCoords !< x,y coordinates for airfoil around each blade node on a blade (relative to reference) [-] - END TYPE DvrVTK_BLSurfaceType -! ======================= -! ========= DvrVTK_SurfaceType ======= - TYPE, PUBLIC :: DvrVTK_SurfaceType - INTEGER(IntKi) :: NumSectors !< number of sectors in which to split circles (higher number gives smoother surface) [-] - REAL(SiKi) , DIMENSION(1:3,1:8) :: NacelleBox !< X-Y-Z locations of 8 points that define the nacelle box, relative to the nacelle position [m] - REAL(SiKi) , DIMENSION(1:3,1:8) :: BaseBox !< X-Y-Z locations of 8 points that define the base box [m] - REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: TowerRad !< radius of each ED tower node [m] - TYPE(DvrVTK_BLSurfaceType) , DIMENSION(:), ALLOCATABLE :: BladeShape !< AirfoilCoords for each blade [m] - END TYPE DvrVTK_SurfaceType -! ======================= -! ========= Dvr_Outputs ======= - TYPE, PUBLIC :: Dvr_Outputs - TYPE(ProgDesc) :: AD_ver !< AeroDyn version information [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: unOutFile !< unit number for writing output file for each rotor [-] - INTEGER(IntKi) :: ActualChanLen !< Actual length of channels written to text file (less than or equal to ChanLen) [-] - INTEGER(IntKi) :: nDvrOutputs !< Number of outputs for the driver (without AD and IW) [-] - character(20) :: Fmt_t !< Format specifier for time channel [-] - character(25) :: Fmt_a !< Format specifier for each column (including delimiter) [-] - character(1) :: delim !< column delimiter [-] - character(20) :: outFmt !< Format specifier [-] - INTEGER(IntKi) :: fileFmt !< Output format 1=Text, 2=Binary, 3=Both [-] - INTEGER(IntKi) :: wrVTK !< 0= no vtk, 1=init only, 2=animation [-] - INTEGER(IntKi) :: WrVTK_Type !< Flag for VTK output type (1=surface, 2=line, 3=both) [-] - character(1024) :: Root !< Output file rootname [-] - character(1024) :: VTK_OutFileRoot !< Output file rootname for vtk [-] - character(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdr !< Channel headers [-] - character(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< Channel units [-] - REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: storage !< nTurbines x nChannel x nTime [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: outLine !< Output line to be written to disk [-] - TYPE(DvrVTK_SurfaceType) , DIMENSION(:), ALLOCATABLE :: VTK_surface !< Data for VTK surface visualization [-] - INTEGER(IntKi) :: VTK_tWidth !< Width of number of files for leading zeros in file name format [-] - INTEGER(IntKi) :: n_VTKTime !< Number of time steps between writing VTK files [-] - REAL(SiKi) :: VTKHubRad !< Hub radius for visualization [m] - REAL(ReKi) , DIMENSION(1:6) :: VTKNacDim !< Nacelle dimensions for visualization [m] - REAL(SiKi) , DIMENSION(1:3) :: VTKRefPoint !< RefPoint for VTK outputs [-] - END TYPE Dvr_Outputs -! ======================= -! ========= AeroDyn_Data ======= - TYPE, PUBLIC :: AeroDyn_Data - TYPE(AD_ContinuousStateType) :: x !< Continuous states [-] - TYPE(AD_DiscreteStateType) :: xd !< Discrete states [-] - TYPE(AD_ConstraintStateType) :: z !< Constraint states [-] - TYPE(AD_OtherStateType) :: OtherState !< Other states [-] - TYPE(AD_MiscVarType) :: m !< misc/optimization variables [-] - TYPE(AD_ParameterType) :: p !< Parameters [-] - TYPE(AD_InputType) , DIMENSION(numInp) :: u !< Array of system inputs [-] - TYPE(AD_OutputType) :: y !< System outputs [-] - REAL(DbKi) , DIMENSION(numInp) :: InputTime !< Array of times associated with u array [-] - END TYPE AeroDyn_Data -! ======================= -! ========= InflowWind_Data ======= - TYPE, PUBLIC :: InflowWind_Data - TYPE(InflowWind_ContinuousStateType) :: x !< Continuous states [-] - TYPE(InflowWind_DiscreteStateType) :: xd !< Discrete states [-] - TYPE(InflowWind_ConstraintStateType) :: z !< Constraint states [-] - TYPE(InflowWind_OtherStateType) :: OtherSt !< Other states [-] - TYPE(InflowWind_ParameterType) :: p !< Parameters [-] - TYPE(InflowWind_MiscVarType) :: m !< Misc/optimization variables [-] - TYPE(InflowWind_InputType) , DIMENSION(1:2) :: u !< Array of inputs associated with InputTimes [-] - TYPE(InflowWind_OutputType) :: y !< System outputs [-] - REAL(DbKi) , DIMENSION(1:2) :: InputTimes !< Array of times associated with Input Array [-] - END TYPE InflowWind_Data -! ======================= -! ========= BladeData ======= - TYPE, PUBLIC :: BladeData - REAL(ReKi) :: pitch !< rad [-] - REAL(ReKi) :: pitchSpeed !< rad/s [-] - REAL(ReKi) :: pitchAcc !< rad/s/s [-] - REAL(ReKi) , DIMENSION(1:3) :: origin_h !< [-] - REAL(ReKi) , DIMENSION(1:3) :: orientation_h !< [-] - REAL(ReKi) :: hubRad_bl !< [-] - REAL(DbKi) , DIMENSION(1:3,1:3) :: Rh2bl0 !< Rotation matrix blade 2 hub [-] - INTEGER(IntKi) :: motionType !< [-] - INTEGER(IntKi) :: iMotion !< Stored index to optimize time interpolation [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: motion !< [-] - character(1024) :: motionFileName !< [-] - TYPE(MeshType) :: ptMesh !< Point mesh for origin motion [-] - TYPE(MeshMapType) :: ED_P_2_AD_P_R !< Mesh mapping from blade to AD hub motion [-] - TYPE(MeshMapType) :: AD_P_2_AD_L_B !< Mesh mapping from AD blade root to AD line mesh [-] - END TYPE BladeData -! ======================= -! ========= HubData ======= - TYPE, PUBLIC :: HubData - REAL(ReKi) , DIMENSION(1:3) :: origin_n !< [-] - REAL(ReKi) , DIMENSION(1:3) :: orientation_n !< [-] - INTEGER(IntKi) :: motionType !< [-] - INTEGER(IntKi) :: iMotion !< Stored index to optimize time interpolation [-] - REAL(ReKi) :: azimuth !< rotor position [rad] - REAL(ReKi) :: rotSpeed !< rotor speed [rad/s] - REAL(ReKi) :: rotAcc !< rotor acceleration [rad/s/s] - character(1024) :: motionFileName !< [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: motion !< [-] - TYPE(MeshType) :: ptMesh !< Point mesh for origin motion [-] - TYPE(MeshMapType) :: ED_P_2_AD_P_H !< Mesh mapping from hub to AD hub motion [-] - TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: map2BldPt !< Mesh mapping from hub to bld root motion [-] - END TYPE HubData -! ======================= -! ========= NacData ======= - TYPE, PUBLIC :: NacData - REAL(ReKi) , DIMENSION(1:3) :: origin_t !< [-] - INTEGER(IntKi) :: motionType !< [-] - INTEGER(IntKi) :: iMotion !< Stored index to optimize time interpolation [-] - REAL(ReKi) :: yaw !< rad [rad] - REAL(ReKi) :: yawSpeed !< yawspeed [rad/s] - REAL(ReKi) :: yawAcc !< yawAcceleration [rad/s^2] - character(1024) :: motionFileName !< [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: motion !< [-] - TYPE(MeshType) :: ptMesh !< Point mesh for origin motion [-] - TYPE(MeshMapType) :: ED_P_2_AD_P_N !< Mesh mapping from nacelle to AD nacelle motion [-] - TYPE(MeshMapType) :: map2hubPt !< Mesh mapping from Nacelle to hub [-] - END TYPE NacData -! ======================= -! ========= TwrData ======= - TYPE, PUBLIC :: TwrData - REAL(ReKi) , DIMENSION(1:3) :: origin_t !< [-] - TYPE(MeshType) :: ptMesh !< Point mesh for origin motion [-] - TYPE(MeshType) :: ptMeshAD !< Point mesh for origin motion [-] - TYPE(MeshMapType) :: ED_P_2_AD_P_T !< Mesh mapping from tower base to AD tower base [-] - TYPE(MeshMapType) :: AD_P_2_AD_L_T !< Mesh mapping from tower base to AD tower line [-] - END TYPE TwrData -! ======================= -! ========= WTData ======= - TYPE, PUBLIC :: WTData - REAL(ReKi) , DIMENSION(1:3) :: originInit !< [-] - REAL(ReKi) , DIMENSION(1:3) :: orientationInit !< [-] - TYPE(MeshType) :: ptMesh !< Point mesh for origin motion [-] - TYPE(MeshMapType) :: map2twrPt !< Mesh mapping from base to tower [-] - TYPE(MeshMapType) :: map2nacPt !< Mesh mapping from base to nacelle [-] - TYPE(BladeData) , DIMENSION(:), ALLOCATABLE :: bld !< [-] - TYPE(HubData) :: hub !< [-] - TYPE(NacData) :: nac !< [-] - TYPE(TwrData) :: twr !< [-] - INTEGER(IntKi) :: numBlades !< [-] - LOGICAL :: basicHAWTFormat !< If true simply input HubRad/Pitch/Overhang/Cone, otherwise all turbine inputs [-] - LOGICAL :: hasTower !< [-] - INTEGER(IntKi) :: projMod !< If true simply input HubRad/Pitch/Overhang/Cone, otherwise all turbine inputs [-] - LOGICAL :: HAWTprojection !< [-] - INTEGER(IntKi) :: motionType !< [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: motion !< [-] - INTEGER(IntKi) :: iMotion !< Stored index to optimize time interpolation [-] - INTEGER(IntKi) :: degreeOfFreedom !< [-] - REAL(ReKi) :: amplitude !< [-] - REAL(ReKi) :: frequency !< [-] - character(1024) :: motionFileName !< [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WriteOutput !< WriteOutputs of the driver only [-] - END TYPE WTData -! ======================= -! ========= Dvr_SimData ======= - TYPE, PUBLIC :: Dvr_SimData - character(1024) :: AD_InputFile !< Name of AeroDyn input file [-] - character(1024) :: IW_InputFile !< Name of InfloWind input file [-] - INTEGER(IntKi) :: MHK !< MHK turbine type (switch) {0: not an MHK turbine, 1: fixed MHK turbine, 2: floating MHK turbine} [-] - INTEGER(IntKi) :: AnalysisType !< 0=Steady Wind, 1=InflowWind [-] - REAL(ReKi) :: FldDens !< Density of working fluid [kg/m^3] - REAL(ReKi) :: KinVisc !< Kinematic viscosity of working fluid [m^2/s] - REAL(ReKi) :: SpdSound !< Speed of sound in working fluid [m/s] - REAL(ReKi) :: Patm !< Atmospheric pressure [Pa] - REAL(ReKi) :: Pvap !< Vapour pressure of working fluid [Pa] - REAL(ReKi) :: WtrDpth !< Water depth [m] - REAL(ReKi) :: MSL2SWL !< Offset between still-water level and mean sea level [m] - INTEGER(IntKi) :: CompInflow !< 0=Steady Wind, 1=InflowWind [-] - REAL(ReKi) :: HWindSpeed !< RefHeight Wind speed [-] - REAL(ReKi) :: RefHt !< RefHeight [-] - REAL(ReKi) :: PLExp !< PLExp [-] - INTEGER(IntKi) :: numTurbines !< number of blades on turbine [-] - TYPE(WTData) , DIMENSION(:), ALLOCATABLE :: WT !< Wind turbine data [-] - REAL(DbKi) :: dT !< time increment [s] - REAL(DbKi) :: tMax !< time increment [s] - INTEGER(IntKi) :: numSteps !< number of steps in this case [-] - INTEGER(IntKi) :: numCases !< number of steps in this case [-] - TYPE(Dvr_Case) , DIMENSION(:), ALLOCATABLE :: Cases !< table of cases to run when AnalysisType=2 [-] - INTEGER(IntKi) :: iCase !< Current Case being run [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: timeSeries !< Times series inputs when AnalysisType=1, 6 columns, Time, WndSpeed, ShearExp, RotSpd, Pitch, Yaw [-] - INTEGER(IntKi) :: iTimeSeries !< Stored index to optimize time interpolation [-] - character(1024) :: root !< Output file rootname [-] - TYPE(Dvr_Outputs) :: out !< data for driver output file [-] - END TYPE Dvr_SimData -! ======================= -! ========= AllData ======= - TYPE, PUBLIC :: AllData - TYPE(Dvr_SimData) :: dvr !< [-] - TYPE(AeroDyn_Data) :: AD !< [-] - TYPE(InflowWind_Data) :: IW !< [-] - INTEGER(IntKi) :: errStat !< [-] - character(ErrMsgLen) :: errMsg !< [-] - LOGICAL :: initialized !< [-] - END TYPE AllData -! ======================= -CONTAINS - SUBROUTINE AD_Dvr_CopyDvr_Case( SrcDvr_CaseData, DstDvr_CaseData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Dvr_Case), INTENT(IN) :: SrcDvr_CaseData - TYPE(Dvr_Case), INTENT(INOUT) :: DstDvr_CaseData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_CopyDvr_Case' -! - ErrStat = ErrID_None - ErrMsg = "" - DstDvr_CaseData%HWindSpeed = SrcDvr_CaseData%HWindSpeed - DstDvr_CaseData%PLExp = SrcDvr_CaseData%PLExp - DstDvr_CaseData%rotSpeed = SrcDvr_CaseData%rotSpeed - DstDvr_CaseData%bldPitch = SrcDvr_CaseData%bldPitch - DstDvr_CaseData%nacYaw = SrcDvr_CaseData%nacYaw - DstDvr_CaseData%tMax = SrcDvr_CaseData%tMax - DstDvr_CaseData%dT = SrcDvr_CaseData%dT - DstDvr_CaseData%numSteps = SrcDvr_CaseData%numSteps - DstDvr_CaseData%DOF = SrcDvr_CaseData%DOF - DstDvr_CaseData%amplitude = SrcDvr_CaseData%amplitude - DstDvr_CaseData%frequency = SrcDvr_CaseData%frequency - END SUBROUTINE AD_Dvr_CopyDvr_Case - - SUBROUTINE AD_Dvr_DestroyDvr_Case( Dvr_CaseData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Dvr_Case), INTENT(INOUT) :: Dvr_CaseData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_DestroyDvr_Case' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE AD_Dvr_DestroyDvr_Case - - SUBROUTINE AD_Dvr_PackDvr_Case( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Dvr_Case), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_PackDvr_Case' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! HWindSpeed - Re_BufSz = Re_BufSz + 1 ! PLExp - Re_BufSz = Re_BufSz + 1 ! rotSpeed - Re_BufSz = Re_BufSz + 1 ! bldPitch - Re_BufSz = Re_BufSz + 1 ! nacYaw - Db_BufSz = Db_BufSz + 1 ! tMax - Db_BufSz = Db_BufSz + 1 ! dT - Int_BufSz = Int_BufSz + 1 ! numSteps - Int_BufSz = Int_BufSz + 1 ! DOF - Re_BufSz = Re_BufSz + 1 ! amplitude - Re_BufSz = Re_BufSz + 1 ! frequency - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%HWindSpeed - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PLExp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rotSpeed - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%bldPitch - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%nacYaw - Re_Xferred = Re_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%tMax - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%dT - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%numSteps - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%DOF - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%amplitude - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%frequency - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AD_Dvr_PackDvr_Case - - SUBROUTINE AD_Dvr_UnPackDvr_Case( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Dvr_Case), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_UnPackDvr_Case' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%HWindSpeed = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PLExp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rotSpeed = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%bldPitch = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%nacYaw = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%tMax = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%dT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%numSteps = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%DOF = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%amplitude = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%frequency = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AD_Dvr_UnPackDvr_Case - - SUBROUTINE AD_Dvr_CopyDvrVTK_BLSurfaceType( SrcDvrVTK_BLSurfaceTypeData, DstDvrVTK_BLSurfaceTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(DvrVTK_BLSurfaceType), INTENT(IN) :: SrcDvrVTK_BLSurfaceTypeData - TYPE(DvrVTK_BLSurfaceType), INTENT(INOUT) :: DstDvrVTK_BLSurfaceTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_CopyDvrVTK_BLSurfaceType' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcDvrVTK_BLSurfaceTypeData%AirfoilCoords)) THEN - i1_l = LBOUND(SrcDvrVTK_BLSurfaceTypeData%AirfoilCoords,1) - i1_u = UBOUND(SrcDvrVTK_BLSurfaceTypeData%AirfoilCoords,1) - i2_l = LBOUND(SrcDvrVTK_BLSurfaceTypeData%AirfoilCoords,2) - i2_u = UBOUND(SrcDvrVTK_BLSurfaceTypeData%AirfoilCoords,2) - i3_l = LBOUND(SrcDvrVTK_BLSurfaceTypeData%AirfoilCoords,3) - i3_u = UBOUND(SrcDvrVTK_BLSurfaceTypeData%AirfoilCoords,3) - IF (.NOT. ALLOCATED(DstDvrVTK_BLSurfaceTypeData%AirfoilCoords)) THEN - ALLOCATE(DstDvrVTK_BLSurfaceTypeData%AirfoilCoords(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDvrVTK_BLSurfaceTypeData%AirfoilCoords.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDvrVTK_BLSurfaceTypeData%AirfoilCoords = SrcDvrVTK_BLSurfaceTypeData%AirfoilCoords -ENDIF - END SUBROUTINE AD_Dvr_CopyDvrVTK_BLSurfaceType - - SUBROUTINE AD_Dvr_DestroyDvrVTK_BLSurfaceType( DvrVTK_BLSurfaceTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(DvrVTK_BLSurfaceType), INTENT(INOUT) :: DvrVTK_BLSurfaceTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_DestroyDvrVTK_BLSurfaceType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(DvrVTK_BLSurfaceTypeData%AirfoilCoords)) THEN - DEALLOCATE(DvrVTK_BLSurfaceTypeData%AirfoilCoords) -ENDIF - END SUBROUTINE AD_Dvr_DestroyDvrVTK_BLSurfaceType - - SUBROUTINE AD_Dvr_PackDvrVTK_BLSurfaceType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(DvrVTK_BLSurfaceType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_PackDvrVTK_BLSurfaceType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! AirfoilCoords allocated yes/no - IF ( ALLOCATED(InData%AirfoilCoords) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! AirfoilCoords upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AirfoilCoords) ! AirfoilCoords - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%AirfoilCoords) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AirfoilCoords,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AirfoilCoords,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AirfoilCoords,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AirfoilCoords,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AirfoilCoords,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AirfoilCoords,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%AirfoilCoords,3), UBOUND(InData%AirfoilCoords,3) - DO i2 = LBOUND(InData%AirfoilCoords,2), UBOUND(InData%AirfoilCoords,2) - DO i1 = LBOUND(InData%AirfoilCoords,1), UBOUND(InData%AirfoilCoords,1) - ReKiBuf(Re_Xferred) = InData%AirfoilCoords(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE AD_Dvr_PackDvrVTK_BLSurfaceType - - SUBROUTINE AD_Dvr_UnPackDvrVTK_BLSurfaceType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(DvrVTK_BLSurfaceType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_UnPackDvrVTK_BLSurfaceType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AirfoilCoords not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AirfoilCoords)) DEALLOCATE(OutData%AirfoilCoords) - ALLOCATE(OutData%AirfoilCoords(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AirfoilCoords.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%AirfoilCoords,3), UBOUND(OutData%AirfoilCoords,3) - DO i2 = LBOUND(OutData%AirfoilCoords,2), UBOUND(OutData%AirfoilCoords,2) - DO i1 = LBOUND(OutData%AirfoilCoords,1), UBOUND(OutData%AirfoilCoords,1) - OutData%AirfoilCoords(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE AD_Dvr_UnPackDvrVTK_BLSurfaceType - - SUBROUTINE AD_Dvr_CopyDvrVTK_SurfaceType( SrcDvrVTK_SurfaceTypeData, DstDvrVTK_SurfaceTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(DvrVTK_SurfaceType), INTENT(IN) :: SrcDvrVTK_SurfaceTypeData - TYPE(DvrVTK_SurfaceType), INTENT(INOUT) :: DstDvrVTK_SurfaceTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_CopyDvrVTK_SurfaceType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstDvrVTK_SurfaceTypeData%NumSectors = SrcDvrVTK_SurfaceTypeData%NumSectors - DstDvrVTK_SurfaceTypeData%NacelleBox = SrcDvrVTK_SurfaceTypeData%NacelleBox - DstDvrVTK_SurfaceTypeData%BaseBox = SrcDvrVTK_SurfaceTypeData%BaseBox -IF (ALLOCATED(SrcDvrVTK_SurfaceTypeData%TowerRad)) THEN - i1_l = LBOUND(SrcDvrVTK_SurfaceTypeData%TowerRad,1) - i1_u = UBOUND(SrcDvrVTK_SurfaceTypeData%TowerRad,1) - IF (.NOT. ALLOCATED(DstDvrVTK_SurfaceTypeData%TowerRad)) THEN - ALLOCATE(DstDvrVTK_SurfaceTypeData%TowerRad(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDvrVTK_SurfaceTypeData%TowerRad.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDvrVTK_SurfaceTypeData%TowerRad = SrcDvrVTK_SurfaceTypeData%TowerRad -ENDIF -IF (ALLOCATED(SrcDvrVTK_SurfaceTypeData%BladeShape)) THEN - i1_l = LBOUND(SrcDvrVTK_SurfaceTypeData%BladeShape,1) - i1_u = UBOUND(SrcDvrVTK_SurfaceTypeData%BladeShape,1) - IF (.NOT. ALLOCATED(DstDvrVTK_SurfaceTypeData%BladeShape)) THEN - ALLOCATE(DstDvrVTK_SurfaceTypeData%BladeShape(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDvrVTK_SurfaceTypeData%BladeShape.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcDvrVTK_SurfaceTypeData%BladeShape,1), UBOUND(SrcDvrVTK_SurfaceTypeData%BladeShape,1) - CALL AD_Dvr_Copydvrvtk_blsurfacetype( SrcDvrVTK_SurfaceTypeData%BladeShape(i1), DstDvrVTK_SurfaceTypeData%BladeShape(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE AD_Dvr_CopyDvrVTK_SurfaceType - - SUBROUTINE AD_Dvr_DestroyDvrVTK_SurfaceType( DvrVTK_SurfaceTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(DvrVTK_SurfaceType), INTENT(INOUT) :: DvrVTK_SurfaceTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_DestroyDvrVTK_SurfaceType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(DvrVTK_SurfaceTypeData%TowerRad)) THEN - DEALLOCATE(DvrVTK_SurfaceTypeData%TowerRad) -ENDIF -IF (ALLOCATED(DvrVTK_SurfaceTypeData%BladeShape)) THEN -DO i1 = LBOUND(DvrVTK_SurfaceTypeData%BladeShape,1), UBOUND(DvrVTK_SurfaceTypeData%BladeShape,1) - CALL AD_Dvr_Destroydvrvtk_blsurfacetype( DvrVTK_SurfaceTypeData%BladeShape(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(DvrVTK_SurfaceTypeData%BladeShape) -ENDIF - END SUBROUTINE AD_Dvr_DestroyDvrVTK_SurfaceType - - SUBROUTINE AD_Dvr_PackDvrVTK_SurfaceType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(DvrVTK_SurfaceType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_PackDvrVTK_SurfaceType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! NumSectors - Re_BufSz = Re_BufSz + SIZE(InData%NacelleBox) ! NacelleBox - Re_BufSz = Re_BufSz + SIZE(InData%BaseBox) ! BaseBox - Int_BufSz = Int_BufSz + 1 ! TowerRad allocated yes/no - IF ( ALLOCATED(InData%TowerRad) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TowerRad upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TowerRad) ! TowerRad - END IF - Int_BufSz = Int_BufSz + 1 ! BladeShape allocated yes/no - IF ( ALLOCATED(InData%BladeShape) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BladeShape upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%BladeShape,1), UBOUND(InData%BladeShape,1) - Int_BufSz = Int_BufSz + 3 ! BladeShape: size of buffers for each call to pack subtype - CALL AD_Dvr_Packdvrvtk_blsurfacetype( Re_Buf, Db_Buf, Int_Buf, InData%BladeShape(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BladeShape - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BladeShape - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BladeShape - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BladeShape - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%NumSectors - Int_Xferred = Int_Xferred + 1 - DO i2 = LBOUND(InData%NacelleBox,2), UBOUND(InData%NacelleBox,2) - DO i1 = LBOUND(InData%NacelleBox,1), UBOUND(InData%NacelleBox,1) - ReKiBuf(Re_Xferred) = InData%NacelleBox(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - DO i2 = LBOUND(InData%BaseBox,2), UBOUND(InData%BaseBox,2) - DO i1 = LBOUND(InData%BaseBox,1), UBOUND(InData%BaseBox,1) - ReKiBuf(Re_Xferred) = InData%BaseBox(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - IF ( .NOT. ALLOCATED(InData%TowerRad) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TowerRad,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TowerRad,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TowerRad,1), UBOUND(InData%TowerRad,1) - ReKiBuf(Re_Xferred) = InData%TowerRad(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BladeShape) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BladeShape,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeShape,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BladeShape,1), UBOUND(InData%BladeShape,1) - CALL AD_Dvr_Packdvrvtk_blsurfacetype( Re_Buf, Db_Buf, Int_Buf, InData%BladeShape(i1), ErrStat2, ErrMsg2, OnlySize ) ! BladeShape - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - END SUBROUTINE AD_Dvr_PackDvrVTK_SurfaceType - - SUBROUTINE AD_Dvr_UnPackDvrVTK_SurfaceType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(DvrVTK_SurfaceType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_UnPackDvrVTK_SurfaceType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%NumSectors = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%NacelleBox,1) - i1_u = UBOUND(OutData%NacelleBox,1) - i2_l = LBOUND(OutData%NacelleBox,2) - i2_u = UBOUND(OutData%NacelleBox,2) - DO i2 = LBOUND(OutData%NacelleBox,2), UBOUND(OutData%NacelleBox,2) - DO i1 = LBOUND(OutData%NacelleBox,1), UBOUND(OutData%NacelleBox,1) - OutData%NacelleBox(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%BaseBox,1) - i1_u = UBOUND(OutData%BaseBox,1) - i2_l = LBOUND(OutData%BaseBox,2) - i2_u = UBOUND(OutData%BaseBox,2) - DO i2 = LBOUND(OutData%BaseBox,2), UBOUND(OutData%BaseBox,2) - DO i1 = LBOUND(OutData%BaseBox,1), UBOUND(OutData%BaseBox,1) - OutData%BaseBox(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TowerRad not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TowerRad)) DEALLOCATE(OutData%TowerRad) - ALLOCATE(OutData%TowerRad(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TowerRad.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TowerRad,1), UBOUND(OutData%TowerRad,1) - OutData%TowerRad(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BladeShape not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BladeShape)) DEALLOCATE(OutData%BladeShape) - ALLOCATE(OutData%BladeShape(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeShape.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BladeShape,1), UBOUND(OutData%BladeShape,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD_Dvr_Unpackdvrvtk_blsurfacetype( Re_Buf, Db_Buf, Int_Buf, OutData%BladeShape(i1), ErrStat2, ErrMsg2 ) ! BladeShape - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - END SUBROUTINE AD_Dvr_UnPackDvrVTK_SurfaceType - - SUBROUTINE AD_Dvr_CopyDvr_Outputs( SrcDvr_OutputsData, DstDvr_OutputsData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Dvr_Outputs), INTENT(IN) :: SrcDvr_OutputsData - TYPE(Dvr_Outputs), INTENT(INOUT) :: DstDvr_OutputsData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_CopyDvr_Outputs' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL NWTC_Library_Copyprogdesc( SrcDvr_OutputsData%AD_ver, DstDvr_OutputsData%AD_ver, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcDvr_OutputsData%unOutFile)) THEN - i1_l = LBOUND(SrcDvr_OutputsData%unOutFile,1) - i1_u = UBOUND(SrcDvr_OutputsData%unOutFile,1) - IF (.NOT. ALLOCATED(DstDvr_OutputsData%unOutFile)) THEN - ALLOCATE(DstDvr_OutputsData%unOutFile(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDvr_OutputsData%unOutFile.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDvr_OutputsData%unOutFile = SrcDvr_OutputsData%unOutFile -ENDIF - DstDvr_OutputsData%ActualChanLen = SrcDvr_OutputsData%ActualChanLen - DstDvr_OutputsData%nDvrOutputs = SrcDvr_OutputsData%nDvrOutputs - DstDvr_OutputsData%Fmt_t = SrcDvr_OutputsData%Fmt_t - DstDvr_OutputsData%Fmt_a = SrcDvr_OutputsData%Fmt_a - DstDvr_OutputsData%delim = SrcDvr_OutputsData%delim - DstDvr_OutputsData%outFmt = SrcDvr_OutputsData%outFmt - DstDvr_OutputsData%fileFmt = SrcDvr_OutputsData%fileFmt - DstDvr_OutputsData%wrVTK = SrcDvr_OutputsData%wrVTK - DstDvr_OutputsData%WrVTK_Type = SrcDvr_OutputsData%WrVTK_Type - DstDvr_OutputsData%Root = SrcDvr_OutputsData%Root - DstDvr_OutputsData%VTK_OutFileRoot = SrcDvr_OutputsData%VTK_OutFileRoot -IF (ALLOCATED(SrcDvr_OutputsData%WriteOutputHdr)) THEN - i1_l = LBOUND(SrcDvr_OutputsData%WriteOutputHdr,1) - i1_u = UBOUND(SrcDvr_OutputsData%WriteOutputHdr,1) - IF (.NOT. ALLOCATED(DstDvr_OutputsData%WriteOutputHdr)) THEN - ALLOCATE(DstDvr_OutputsData%WriteOutputHdr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDvr_OutputsData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDvr_OutputsData%WriteOutputHdr = SrcDvr_OutputsData%WriteOutputHdr -ENDIF -IF (ALLOCATED(SrcDvr_OutputsData%WriteOutputUnt)) THEN - i1_l = LBOUND(SrcDvr_OutputsData%WriteOutputUnt,1) - i1_u = UBOUND(SrcDvr_OutputsData%WriteOutputUnt,1) - IF (.NOT. ALLOCATED(DstDvr_OutputsData%WriteOutputUnt)) THEN - ALLOCATE(DstDvr_OutputsData%WriteOutputUnt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDvr_OutputsData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDvr_OutputsData%WriteOutputUnt = SrcDvr_OutputsData%WriteOutputUnt -ENDIF -IF (ALLOCATED(SrcDvr_OutputsData%storage)) THEN - i1_l = LBOUND(SrcDvr_OutputsData%storage,1) - i1_u = UBOUND(SrcDvr_OutputsData%storage,1) - i2_l = LBOUND(SrcDvr_OutputsData%storage,2) - i2_u = UBOUND(SrcDvr_OutputsData%storage,2) - i3_l = LBOUND(SrcDvr_OutputsData%storage,3) - i3_u = UBOUND(SrcDvr_OutputsData%storage,3) - IF (.NOT. ALLOCATED(DstDvr_OutputsData%storage)) THEN - ALLOCATE(DstDvr_OutputsData%storage(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDvr_OutputsData%storage.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDvr_OutputsData%storage = SrcDvr_OutputsData%storage -ENDIF -IF (ALLOCATED(SrcDvr_OutputsData%outLine)) THEN - i1_l = LBOUND(SrcDvr_OutputsData%outLine,1) - i1_u = UBOUND(SrcDvr_OutputsData%outLine,1) - IF (.NOT. ALLOCATED(DstDvr_OutputsData%outLine)) THEN - ALLOCATE(DstDvr_OutputsData%outLine(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDvr_OutputsData%outLine.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDvr_OutputsData%outLine = SrcDvr_OutputsData%outLine -ENDIF -IF (ALLOCATED(SrcDvr_OutputsData%VTK_surface)) THEN - i1_l = LBOUND(SrcDvr_OutputsData%VTK_surface,1) - i1_u = UBOUND(SrcDvr_OutputsData%VTK_surface,1) - IF (.NOT. ALLOCATED(DstDvr_OutputsData%VTK_surface)) THEN - ALLOCATE(DstDvr_OutputsData%VTK_surface(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDvr_OutputsData%VTK_surface.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcDvr_OutputsData%VTK_surface,1), UBOUND(SrcDvr_OutputsData%VTK_surface,1) - CALL AD_Dvr_Copydvrvtk_surfacetype( SrcDvr_OutputsData%VTK_surface(i1), DstDvr_OutputsData%VTK_surface(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstDvr_OutputsData%VTK_tWidth = SrcDvr_OutputsData%VTK_tWidth - DstDvr_OutputsData%n_VTKTime = SrcDvr_OutputsData%n_VTKTime - DstDvr_OutputsData%VTKHubRad = SrcDvr_OutputsData%VTKHubRad - DstDvr_OutputsData%VTKNacDim = SrcDvr_OutputsData%VTKNacDim - DstDvr_OutputsData%VTKRefPoint = SrcDvr_OutputsData%VTKRefPoint - END SUBROUTINE AD_Dvr_CopyDvr_Outputs - - SUBROUTINE AD_Dvr_DestroyDvr_Outputs( Dvr_OutputsData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Dvr_Outputs), INTENT(INOUT) :: Dvr_OutputsData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_DestroyDvr_Outputs' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL NWTC_Library_Destroyprogdesc( Dvr_OutputsData%AD_ver, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(Dvr_OutputsData%unOutFile)) THEN - DEALLOCATE(Dvr_OutputsData%unOutFile) -ENDIF -IF (ALLOCATED(Dvr_OutputsData%WriteOutputHdr)) THEN - DEALLOCATE(Dvr_OutputsData%WriteOutputHdr) -ENDIF -IF (ALLOCATED(Dvr_OutputsData%WriteOutputUnt)) THEN - DEALLOCATE(Dvr_OutputsData%WriteOutputUnt) -ENDIF -IF (ALLOCATED(Dvr_OutputsData%storage)) THEN - DEALLOCATE(Dvr_OutputsData%storage) -ENDIF -IF (ALLOCATED(Dvr_OutputsData%outLine)) THEN - DEALLOCATE(Dvr_OutputsData%outLine) -ENDIF -IF (ALLOCATED(Dvr_OutputsData%VTK_surface)) THEN -DO i1 = LBOUND(Dvr_OutputsData%VTK_surface,1), UBOUND(Dvr_OutputsData%VTK_surface,1) - CALL AD_Dvr_Destroydvrvtk_surfacetype( Dvr_OutputsData%VTK_surface(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(Dvr_OutputsData%VTK_surface) -ENDIF - END SUBROUTINE AD_Dvr_DestroyDvr_Outputs - - SUBROUTINE AD_Dvr_PackDvr_Outputs( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Dvr_Outputs), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_PackDvr_Outputs' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! AD_ver: size of buffers for each call to pack subtype - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%AD_ver, ErrStat2, ErrMsg2, .TRUE. ) ! AD_ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AD_ver - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AD_ver - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AD_ver - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! unOutFile allocated yes/no - IF ( ALLOCATED(InData%unOutFile) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! unOutFile upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%unOutFile) ! unOutFile - END IF - Int_BufSz = Int_BufSz + 1 ! ActualChanLen - Int_BufSz = Int_BufSz + 1 ! nDvrOutputs - Int_BufSz = Int_BufSz + 1*LEN(InData%Fmt_t) ! Fmt_t - Int_BufSz = Int_BufSz + 1*LEN(InData%Fmt_a) ! Fmt_a - Int_BufSz = Int_BufSz + 1*LEN(InData%delim) ! delim - Int_BufSz = Int_BufSz + 1*LEN(InData%outFmt) ! outFmt - Int_BufSz = Int_BufSz + 1 ! fileFmt - Int_BufSz = Int_BufSz + 1 ! wrVTK - Int_BufSz = Int_BufSz + 1 ! WrVTK_Type - Int_BufSz = Int_BufSz + 1*LEN(InData%Root) ! Root - Int_BufSz = Int_BufSz + 1*LEN(InData%VTK_OutFileRoot) ! VTK_OutFileRoot - Int_BufSz = Int_BufSz + 1 ! WriteOutputHdr allocated yes/no - IF ( ALLOCATED(InData%WriteOutputHdr) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputHdr upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputHdr)*LEN(InData%WriteOutputHdr) ! WriteOutputHdr - END IF - Int_BufSz = Int_BufSz + 1 ! WriteOutputUnt allocated yes/no - IF ( ALLOCATED(InData%WriteOutputUnt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputUnt upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputUnt)*LEN(InData%WriteOutputUnt) ! WriteOutputUnt - END IF - Int_BufSz = Int_BufSz + 1 ! storage allocated yes/no - IF ( ALLOCATED(InData%storage) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! storage upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%storage) ! storage - END IF - Int_BufSz = Int_BufSz + 1 ! outLine allocated yes/no - IF ( ALLOCATED(InData%outLine) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! outLine upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%outLine) ! outLine - END IF - Int_BufSz = Int_BufSz + 1 ! VTK_surface allocated yes/no - IF ( ALLOCATED(InData%VTK_surface) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! VTK_surface upper/lower bounds for each dimension - DO i1 = LBOUND(InData%VTK_surface,1), UBOUND(InData%VTK_surface,1) - Int_BufSz = Int_BufSz + 3 ! VTK_surface: size of buffers for each call to pack subtype - CALL AD_Dvr_Packdvrvtk_surfacetype( Re_Buf, Db_Buf, Int_Buf, InData%VTK_surface(i1), ErrStat2, ErrMsg2, .TRUE. ) ! VTK_surface - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! VTK_surface - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! VTK_surface - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! VTK_surface - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! VTK_tWidth - Int_BufSz = Int_BufSz + 1 ! n_VTKTime - Re_BufSz = Re_BufSz + 1 ! VTKHubRad - Re_BufSz = Re_BufSz + SIZE(InData%VTKNacDim) ! VTKNacDim - Re_BufSz = Re_BufSz + SIZE(InData%VTKRefPoint) ! VTKRefPoint - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%AD_ver, ErrStat2, ErrMsg2, OnlySize ) ! AD_ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%unOutFile) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%unOutFile,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%unOutFile,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%unOutFile,1), UBOUND(InData%unOutFile,1) - IntKiBuf(Int_Xferred) = InData%unOutFile(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%ActualChanLen - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nDvrOutputs - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%Fmt_t) - IntKiBuf(Int_Xferred) = ICHAR(InData%Fmt_t(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%Fmt_a) - IntKiBuf(Int_Xferred) = ICHAR(InData%Fmt_a(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%delim) - IntKiBuf(Int_Xferred) = ICHAR(InData%delim(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%outFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%outFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%fileFmt - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%wrVTK - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WrVTK_Type - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%Root) - IntKiBuf(Int_Xferred) = ICHAR(InData%Root(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%VTK_OutFileRoot) - IntKiBuf(Int_Xferred) = ICHAR(InData%VTK_OutFileRoot(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( .NOT. ALLOCATED(InData%WriteOutputHdr) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputHdr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) - DO I = 1, LEN(InData%WriteOutputHdr) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputHdr(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputUnt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) - DO I = 1, LEN(InData%WriteOutputUnt) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputUnt(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%storage) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%storage,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%storage,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%storage,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%storage,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%storage,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%storage,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%storage,3), UBOUND(InData%storage,3) - DO i2 = LBOUND(InData%storage,2), UBOUND(InData%storage,2) - DO i1 = LBOUND(InData%storage,1), UBOUND(InData%storage,1) - ReKiBuf(Re_Xferred) = InData%storage(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%outLine) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%outLine,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%outLine,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%outLine,1), UBOUND(InData%outLine,1) - ReKiBuf(Re_Xferred) = InData%outLine(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%VTK_surface) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%VTK_surface,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VTK_surface,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%VTK_surface,1), UBOUND(InData%VTK_surface,1) - CALL AD_Dvr_Packdvrvtk_surfacetype( Re_Buf, Db_Buf, Int_Buf, InData%VTK_surface(i1), ErrStat2, ErrMsg2, OnlySize ) ! VTK_surface - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IntKiBuf(Int_Xferred) = InData%VTK_tWidth - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%n_VTKTime - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VTKHubRad - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%VTKNacDim,1), UBOUND(InData%VTKNacDim,1) - ReKiBuf(Re_Xferred) = InData%VTKNacDim(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%VTKRefPoint,1), UBOUND(InData%VTKRefPoint,1) - ReKiBuf(Re_Xferred) = InData%VTKRefPoint(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END SUBROUTINE AD_Dvr_PackDvr_Outputs - - SUBROUTINE AD_Dvr_UnPackDvr_Outputs( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Dvr_Outputs), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_UnPackDvr_Outputs' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_Unpackprogdesc( Re_Buf, Db_Buf, Int_Buf, OutData%AD_ver, ErrStat2, ErrMsg2 ) ! AD_ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! unOutFile not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%unOutFile)) DEALLOCATE(OutData%unOutFile) - ALLOCATE(OutData%unOutFile(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%unOutFile.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%unOutFile,1), UBOUND(OutData%unOutFile,1) - OutData%unOutFile(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%ActualChanLen = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nDvrOutputs = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%Fmt_t) - OutData%Fmt_t(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%Fmt_a) - OutData%Fmt_a(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%delim) - OutData%delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%outFmt) - OutData%outFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%fileFmt = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%wrVTK = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WrVTK_Type = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%Root) - OutData%Root(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%VTK_OutFileRoot) - OutData%VTK_OutFileRoot(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputHdr not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutputHdr)) DEALLOCATE(OutData%WriteOutputHdr) - ALLOCATE(OutData%WriteOutputHdr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) - DO I = 1, LEN(OutData%WriteOutputHdr) - OutData%WriteOutputHdr(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutputUnt)) DEALLOCATE(OutData%WriteOutputUnt) - ALLOCATE(OutData%WriteOutputUnt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) - DO I = 1, LEN(OutData%WriteOutputUnt) - OutData%WriteOutputUnt(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! storage not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%storage)) DEALLOCATE(OutData%storage) - ALLOCATE(OutData%storage(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%storage.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%storage,3), UBOUND(OutData%storage,3) - DO i2 = LBOUND(OutData%storage,2), UBOUND(OutData%storage,2) - DO i1 = LBOUND(OutData%storage,1), UBOUND(OutData%storage,1) - OutData%storage(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! outLine not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%outLine)) DEALLOCATE(OutData%outLine) - ALLOCATE(OutData%outLine(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%outLine.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%outLine,1), UBOUND(OutData%outLine,1) - OutData%outLine(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! VTK_surface not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%VTK_surface)) DEALLOCATE(OutData%VTK_surface) - ALLOCATE(OutData%VTK_surface(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%VTK_surface.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%VTK_surface,1), UBOUND(OutData%VTK_surface,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD_Dvr_Unpackdvrvtk_surfacetype( Re_Buf, Db_Buf, Int_Buf, OutData%VTK_surface(i1), ErrStat2, ErrMsg2 ) ! VTK_surface - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - OutData%VTK_tWidth = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%n_VTKTime = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%VTKHubRad = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%VTKNacDim,1) - i1_u = UBOUND(OutData%VTKNacDim,1) - DO i1 = LBOUND(OutData%VTKNacDim,1), UBOUND(OutData%VTKNacDim,1) - OutData%VTKNacDim(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%VTKRefPoint,1) - i1_u = UBOUND(OutData%VTKRefPoint,1) - DO i1 = LBOUND(OutData%VTKRefPoint,1), UBOUND(OutData%VTKRefPoint,1) - OutData%VTKRefPoint(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END SUBROUTINE AD_Dvr_UnPackDvr_Outputs - - SUBROUTINE AD_Dvr_CopyAeroDyn_Data( SrcAeroDyn_DataData, DstAeroDyn_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AeroDyn_Data), INTENT(INOUT) :: SrcAeroDyn_DataData - TYPE(AeroDyn_Data), INTENT(INOUT) :: DstAeroDyn_DataData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_CopyAeroDyn_Data' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL AD_CopyContState( SrcAeroDyn_DataData%x, DstAeroDyn_DataData%x, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD_CopyDiscState( SrcAeroDyn_DataData%xd, DstAeroDyn_DataData%xd, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD_CopyConstrState( SrcAeroDyn_DataData%z, DstAeroDyn_DataData%z, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD_CopyOtherState( SrcAeroDyn_DataData%OtherState, DstAeroDyn_DataData%OtherState, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD_CopyMisc( SrcAeroDyn_DataData%m, DstAeroDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD_CopyParam( SrcAeroDyn_DataData%p, DstAeroDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DO i1 = LBOUND(SrcAeroDyn_DataData%u,1), UBOUND(SrcAeroDyn_DataData%u,1) - CALL AD_CopyInput( SrcAeroDyn_DataData%u(i1), DstAeroDyn_DataData%u(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - CALL AD_CopyOutput( SrcAeroDyn_DataData%y, DstAeroDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstAeroDyn_DataData%InputTime = SrcAeroDyn_DataData%InputTime - END SUBROUTINE AD_Dvr_CopyAeroDyn_Data - - SUBROUTINE AD_Dvr_DestroyAeroDyn_Data( AeroDyn_DataData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(AeroDyn_Data), INTENT(INOUT) :: AeroDyn_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_DestroyAeroDyn_Data' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL AD_DestroyContState( AeroDyn_DataData%x, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD_DestroyDiscState( AeroDyn_DataData%xd, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD_DestroyConstrState( AeroDyn_DataData%z, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD_DestroyOtherState( AeroDyn_DataData%OtherState, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD_DestroyMisc( AeroDyn_DataData%m, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD_DestroyParam( AeroDyn_DataData%p, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -DO i1 = LBOUND(AeroDyn_DataData%u,1), UBOUND(AeroDyn_DataData%u,1) - CALL AD_DestroyInput( AeroDyn_DataData%u(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - CALL AD_DestroyOutput( AeroDyn_DataData%y, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AD_Dvr_DestroyAeroDyn_Data - - SUBROUTINE AD_Dvr_PackAeroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(AeroDyn_Data), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_PackAeroDyn_Data' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL AD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x, ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL AD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd, ErrStat2, ErrMsg2, .TRUE. ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL AD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z, ErrStat2, ErrMsg2, .TRUE. ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! OtherState: size of buffers for each call to pack subtype - CALL AD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherState, ErrStat2, ErrMsg2, .TRUE. ) ! OtherState - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherState - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherState - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherState - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL AD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL AD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - DO i1 = LBOUND(InData%u,1), UBOUND(InData%u,1) - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL AD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL AD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Db_BufSz = Db_BufSz + SIZE(InData%InputTime) ! InputTime - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL AD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x, ErrStat2, ErrMsg2, OnlySize ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL AD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd, ErrStat2, ErrMsg2, OnlySize ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL AD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z, ErrStat2, ErrMsg2, OnlySize ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL AD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherState, ErrStat2, ErrMsg2, OnlySize ) ! OtherState - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL AD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL AD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - DO i1 = LBOUND(InData%u,1), UBOUND(InData%u,1) - CALL AD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u(i1), ErrStat2, ErrMsg2, OnlySize ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - CALL AD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - DO i1 = LBOUND(InData%InputTime,1), UBOUND(InData%InputTime,1) - DbKiBuf(Db_Xferred) = InData%InputTime(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END SUBROUTINE AD_Dvr_PackAeroDyn_Data - - SUBROUTINE AD_Dvr_UnPackAeroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(AeroDyn_Data), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_UnPackAeroDyn_Data' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x, ErrStat2, ErrMsg2 ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd, ErrStat2, ErrMsg2 ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z, ErrStat2, ErrMsg2 ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherState, ErrStat2, ErrMsg2 ) ! OtherState - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - i1_l = LBOUND(OutData%u,1) - i1_u = UBOUND(OutData%u,1) - DO i1 = LBOUND(OutData%u,1), UBOUND(OutData%u,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u(i1), ErrStat2, ErrMsg2 ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - i1_l = LBOUND(OutData%InputTime,1) - i1_u = UBOUND(OutData%InputTime,1) - DO i1 = LBOUND(OutData%InputTime,1), UBOUND(OutData%InputTime,1) - OutData%InputTime(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END SUBROUTINE AD_Dvr_UnPackAeroDyn_Data - - SUBROUTINE AD_Dvr_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 = 'AD_Dvr_CopyInflowWind_Data' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL InflowWind_CopyContState( SrcInflowWind_DataData%x, DstInflowWind_DataData%x, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL InflowWind_CopyDiscState( SrcInflowWind_DataData%xd, DstInflowWind_DataData%xd, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL InflowWind_CopyConstrState( SrcInflowWind_DataData%z, DstInflowWind_DataData%z, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL InflowWind_CopyOtherState( SrcInflowWind_DataData%OtherSt, DstInflowWind_DataData%OtherSt, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - 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_CopyMisc( SrcInflowWind_DataData%m, DstInflowWind_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DO i1 = LBOUND(SrcInflowWind_DataData%u,1), UBOUND(SrcInflowWind_DataData%u,1) - CALL InflowWind_CopyInput( SrcInflowWind_DataData%u(i1), DstInflowWind_DataData%u(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - CALL InflowWind_CopyOutput( SrcInflowWind_DataData%y, DstInflowWind_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstInflowWind_DataData%InputTimes = SrcInflowWind_DataData%InputTimes - END SUBROUTINE AD_Dvr_CopyInflowWind_Data - - SUBROUTINE AD_Dvr_DestroyInflowWind_Data( InflowWind_DataData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(InflowWind_Data), INTENT(INOUT) :: InflowWind_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_DestroyInflowWind_Data' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL InflowWind_DestroyContState( InflowWind_DataData%x, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyDiscState( InflowWind_DataData%xd, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyConstrState( InflowWind_DataData%z, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyOtherState( InflowWind_DataData%OtherSt, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyParam( InflowWind_DataData%p, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyMisc( InflowWind_DataData%m, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -DO i1 = LBOUND(InflowWind_DataData%u,1), UBOUND(InflowWind_DataData%u,1) - CALL InflowWind_DestroyInput( InflowWind_DataData%u(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - CALL InflowWind_DestroyOutput( InflowWind_DataData%y, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AD_Dvr_DestroyInflowWind_Data - - SUBROUTINE AD_Dvr_PackInflowWind_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - 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 = 'AD_Dvr_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) - Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL InflowWind_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x, ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL InflowWind_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd, ErrStat2, ErrMsg2, .TRUE. ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL InflowWind_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z, ErrStat2, ErrMsg2, .TRUE. ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL InflowWind_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt, ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL InflowWind_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL InflowWind_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - DO i1 = LBOUND(InData%u,1), UBOUND(InData%u,1) - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - 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 - Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL InflowWind_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x, ErrStat2, ErrMsg2, OnlySize ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL InflowWind_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd, ErrStat2, ErrMsg2, OnlySize ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL InflowWind_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z, ErrStat2, ErrMsg2, OnlySize ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL InflowWind_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt, ErrStat2, ErrMsg2, OnlySize ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL InflowWind_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL InflowWind_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - DO i1 = LBOUND(InData%u,1), UBOUND(InData%u,1) - CALL InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u(i1), ErrStat2, ErrMsg2, OnlySize ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - CALL InflowWind_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) - DbKiBuf(Db_Xferred) = InData%InputTimes(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END SUBROUTINE AD_Dvr_PackInflowWind_Data - - SUBROUTINE AD_Dvr_UnPackInflowWind_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(InflowWind_Data), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_UnPackInflowWind_Data' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL InflowWind_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x, ErrStat2, ErrMsg2 ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL InflowWind_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd, ErrStat2, ErrMsg2 ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL InflowWind_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z, ErrStat2, ErrMsg2 ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL InflowWind_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt, ErrStat2, ErrMsg2 ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL InflowWind_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL InflowWind_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - i1_l = LBOUND(OutData%u,1) - i1_u = UBOUND(OutData%u,1) - DO i1 = LBOUND(OutData%u,1), UBOUND(OutData%u,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL InflowWind_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u(i1), ErrStat2, ErrMsg2 ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL InflowWind_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - i1_l = LBOUND(OutData%InputTimes,1) - i1_u = UBOUND(OutData%InputTimes,1) - DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) - OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END SUBROUTINE AD_Dvr_UnPackInflowWind_Data - - SUBROUTINE AD_Dvr_CopyBladeData( SrcBladeDataData, DstBladeDataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BladeData), INTENT(INOUT) :: SrcBladeDataData - TYPE(BladeData), INTENT(INOUT) :: DstBladeDataData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_CopyBladeData' -! - ErrStat = ErrID_None - ErrMsg = "" - DstBladeDataData%pitch = SrcBladeDataData%pitch - DstBladeDataData%pitchSpeed = SrcBladeDataData%pitchSpeed - DstBladeDataData%pitchAcc = SrcBladeDataData%pitchAcc - DstBladeDataData%origin_h = SrcBladeDataData%origin_h - DstBladeDataData%orientation_h = SrcBladeDataData%orientation_h - DstBladeDataData%hubRad_bl = SrcBladeDataData%hubRad_bl - DstBladeDataData%Rh2bl0 = SrcBladeDataData%Rh2bl0 - DstBladeDataData%motionType = SrcBladeDataData%motionType - DstBladeDataData%iMotion = SrcBladeDataData%iMotion -IF (ALLOCATED(SrcBladeDataData%motion)) THEN - i1_l = LBOUND(SrcBladeDataData%motion,1) - i1_u = UBOUND(SrcBladeDataData%motion,1) - i2_l = LBOUND(SrcBladeDataData%motion,2) - i2_u = UBOUND(SrcBladeDataData%motion,2) - IF (.NOT. ALLOCATED(DstBladeDataData%motion)) THEN - ALLOCATE(DstBladeDataData%motion(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladeDataData%motion.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladeDataData%motion = SrcBladeDataData%motion -ENDIF - DstBladeDataData%motionFileName = SrcBladeDataData%motionFileName - CALL MeshCopy( SrcBladeDataData%ptMesh, DstBladeDataData%ptMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcBladeDataData%ED_P_2_AD_P_R, DstBladeDataData%ED_P_2_AD_P_R, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcBladeDataData%AD_P_2_AD_L_B, DstBladeDataData%AD_P_2_AD_L_B, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE AD_Dvr_CopyBladeData - - SUBROUTINE AD_Dvr_DestroyBladeData( BladeDataData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(BladeData), INTENT(INOUT) :: BladeDataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_DestroyBladeData' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(BladeDataData%motion)) THEN - DEALLOCATE(BladeDataData%motion) -ENDIF - CALL MeshDestroy( BladeDataData%ptMesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_Destroymeshmaptype( BladeDataData%ED_P_2_AD_P_R, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_Destroymeshmaptype( BladeDataData%AD_P_2_AD_L_B, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AD_Dvr_DestroyBladeData - - SUBROUTINE AD_Dvr_PackBladeData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(BladeData), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_PackBladeData' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! pitch - Re_BufSz = Re_BufSz + 1 ! pitchSpeed - Re_BufSz = Re_BufSz + 1 ! pitchAcc - Re_BufSz = Re_BufSz + SIZE(InData%origin_h) ! origin_h - Re_BufSz = Re_BufSz + SIZE(InData%orientation_h) ! orientation_h - Re_BufSz = Re_BufSz + 1 ! hubRad_bl - Db_BufSz = Db_BufSz + SIZE(InData%Rh2bl0) ! Rh2bl0 - Int_BufSz = Int_BufSz + 1 ! motionType - Int_BufSz = Int_BufSz + 1 ! iMotion - Int_BufSz = Int_BufSz + 1 ! motion allocated yes/no - IF ( ALLOCATED(InData%motion) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! motion upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%motion) ! motion - END IF - Int_BufSz = Int_BufSz + 1*LEN(InData%motionFileName) ! motionFileName - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! ptMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%ptMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! ptMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ptMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ptMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ptMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - 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, 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 - Int_BufSz = Int_BufSz + 3 ! AD_P_2_AD_L_B: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%AD_P_2_AD_L_B, ErrStat2, ErrMsg2, .TRUE. ) ! AD_P_2_AD_L_B - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AD_P_2_AD_L_B - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AD_P_2_AD_L_B - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AD_P_2_AD_L_B - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%pitch - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%pitchSpeed - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%pitchAcc - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%origin_h,1), UBOUND(InData%origin_h,1) - ReKiBuf(Re_Xferred) = InData%origin_h(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%orientation_h,1), UBOUND(InData%orientation_h,1) - ReKiBuf(Re_Xferred) = InData%orientation_h(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%hubRad_bl - Re_Xferred = Re_Xferred + 1 - DO i2 = LBOUND(InData%Rh2bl0,2), UBOUND(InData%Rh2bl0,2) - DO i1 = LBOUND(InData%Rh2bl0,1), UBOUND(InData%Rh2bl0,1) - DbKiBuf(Db_Xferred) = InData%Rh2bl0(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - IntKiBuf(Int_Xferred) = InData%motionType - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%iMotion - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%motion) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%motion,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%motion,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%motion,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%motion,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%motion,2), UBOUND(InData%motion,2) - DO i1 = LBOUND(InData%motion,1), UBOUND(InData%motion,1) - ReKiBuf(Re_Xferred) = InData%motion(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - DO I = 1, LEN(InData%motionFileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%motionFileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - CALL MeshPack( InData%ptMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! ptMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_R, ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_AD_P_R - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%AD_P_2_AD_L_B, ErrStat2, ErrMsg2, OnlySize ) ! AD_P_2_AD_L_B - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE AD_Dvr_PackBladeData - - SUBROUTINE AD_Dvr_UnPackBladeData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(BladeData), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_UnPackBladeData' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%pitch = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%pitchSpeed = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%pitchAcc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%origin_h,1) - i1_u = UBOUND(OutData%origin_h,1) - DO i1 = LBOUND(OutData%origin_h,1), UBOUND(OutData%origin_h,1) - OutData%origin_h(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%orientation_h,1) - i1_u = UBOUND(OutData%orientation_h,1) - DO i1 = LBOUND(OutData%orientation_h,1), UBOUND(OutData%orientation_h,1) - OutData%orientation_h(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%hubRad_bl = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%Rh2bl0,1) - i1_u = UBOUND(OutData%Rh2bl0,1) - i2_l = LBOUND(OutData%Rh2bl0,2) - i2_u = UBOUND(OutData%Rh2bl0,2) - DO i2 = LBOUND(OutData%Rh2bl0,2), UBOUND(OutData%Rh2bl0,2) - DO i1 = LBOUND(OutData%Rh2bl0,1), UBOUND(OutData%Rh2bl0,1) - OutData%Rh2bl0(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - OutData%motionType = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%iMotion = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! motion not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%motion)) DEALLOCATE(OutData%motion) - ALLOCATE(OutData%motion(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%motion.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%motion,2), UBOUND(OutData%motion,2) - DO i1 = LBOUND(OutData%motion,1), UBOUND(OutData%motion,1) - OutData%motion(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - DO I = 1, LEN(OutData%motionFileName) - OutData%motionFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, 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%ptMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! ptMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_AD_P_R, ErrStat2, ErrMsg2 ) ! ED_P_2_AD_P_R - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%AD_P_2_AD_L_B, ErrStat2, ErrMsg2 ) ! AD_P_2_AD_L_B - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE AD_Dvr_UnPackBladeData - - SUBROUTINE AD_Dvr_CopyHubData( SrcHubDataData, DstHubDataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(HubData), INTENT(INOUT) :: SrcHubDataData - TYPE(HubData), INTENT(INOUT) :: DstHubDataData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_CopyHubData' -! - ErrStat = ErrID_None - ErrMsg = "" - DstHubDataData%origin_n = SrcHubDataData%origin_n - DstHubDataData%orientation_n = SrcHubDataData%orientation_n - DstHubDataData%motionType = SrcHubDataData%motionType - DstHubDataData%iMotion = SrcHubDataData%iMotion - DstHubDataData%azimuth = SrcHubDataData%azimuth - DstHubDataData%rotSpeed = SrcHubDataData%rotSpeed - DstHubDataData%rotAcc = SrcHubDataData%rotAcc - DstHubDataData%motionFileName = SrcHubDataData%motionFileName -IF (ALLOCATED(SrcHubDataData%motion)) THEN - i1_l = LBOUND(SrcHubDataData%motion,1) - i1_u = UBOUND(SrcHubDataData%motion,1) - i2_l = LBOUND(SrcHubDataData%motion,2) - i2_u = UBOUND(SrcHubDataData%motion,2) - IF (.NOT. ALLOCATED(DstHubDataData%motion)) THEN - ALLOCATE(DstHubDataData%motion(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstHubDataData%motion.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstHubDataData%motion = SrcHubDataData%motion -ENDIF - CALL MeshCopy( SrcHubDataData%ptMesh, DstHubDataData%ptMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcHubDataData%ED_P_2_AD_P_H, DstHubDataData%ED_P_2_AD_P_H, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcHubDataData%map2BldPt)) THEN - i1_l = LBOUND(SrcHubDataData%map2BldPt,1) - i1_u = UBOUND(SrcHubDataData%map2BldPt,1) - IF (.NOT. ALLOCATED(DstHubDataData%map2BldPt)) THEN - ALLOCATE(DstHubDataData%map2BldPt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstHubDataData%map2BldPt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcHubDataData%map2BldPt,1), UBOUND(SrcHubDataData%map2BldPt,1) - CALL NWTC_Library_Copymeshmaptype( SrcHubDataData%map2BldPt(i1), DstHubDataData%map2BldPt(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE AD_Dvr_CopyHubData - - SUBROUTINE AD_Dvr_DestroyHubData( HubDataData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(HubData), INTENT(INOUT) :: HubDataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_DestroyHubData' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(HubDataData%motion)) THEN - DEALLOCATE(HubDataData%motion) -ENDIF - CALL MeshDestroy( HubDataData%ptMesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_Destroymeshmaptype( HubDataData%ED_P_2_AD_P_H, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(HubDataData%map2BldPt)) THEN -DO i1 = LBOUND(HubDataData%map2BldPt,1), UBOUND(HubDataData%map2BldPt,1) - CALL NWTC_Library_Destroymeshmaptype( HubDataData%map2BldPt(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(HubDataData%map2BldPt) -ENDIF - END SUBROUTINE AD_Dvr_DestroyHubData - - SUBROUTINE AD_Dvr_PackHubData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(HubData), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_PackHubData' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + SIZE(InData%origin_n) ! origin_n - Re_BufSz = Re_BufSz + SIZE(InData%orientation_n) ! orientation_n - Int_BufSz = Int_BufSz + 1 ! motionType - Int_BufSz = Int_BufSz + 1 ! iMotion - Re_BufSz = Re_BufSz + 1 ! azimuth - Re_BufSz = Re_BufSz + 1 ! rotSpeed - Re_BufSz = Re_BufSz + 1 ! rotAcc - Int_BufSz = Int_BufSz + 1*LEN(InData%motionFileName) ! motionFileName - Int_BufSz = Int_BufSz + 1 ! motion allocated yes/no - IF ( ALLOCATED(InData%motion) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! motion upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%motion) ! motion - END IF - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! ptMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%ptMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! ptMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ptMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ptMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ptMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - 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 + 1 ! map2BldPt allocated yes/no - IF ( ALLOCATED(InData%map2BldPt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! map2BldPt upper/lower bounds for each dimension - DO i1 = LBOUND(InData%map2BldPt,1), UBOUND(InData%map2BldPt,1) - Int_BufSz = Int_BufSz + 3 ! map2BldPt: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%map2BldPt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! map2BldPt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! map2BldPt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! map2BldPt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! map2BldPt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO i1 = LBOUND(InData%origin_n,1), UBOUND(InData%origin_n,1) - ReKiBuf(Re_Xferred) = InData%origin_n(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%orientation_n,1), UBOUND(InData%orientation_n,1) - ReKiBuf(Re_Xferred) = InData%orientation_n(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%motionType - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%iMotion - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%azimuth - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rotSpeed - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rotAcc - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(InData%motionFileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%motionFileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( .NOT. ALLOCATED(InData%motion) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%motion,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%motion,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%motion,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%motion,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%motion,2), UBOUND(InData%motion,2) - DO i1 = LBOUND(InData%motion,1), UBOUND(InData%motion,1) - ReKiBuf(Re_Xferred) = InData%motion(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - CALL MeshPack( InData%ptMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! ptMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_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 - IF ( .NOT. ALLOCATED(InData%map2BldPt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%map2BldPt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%map2BldPt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%map2BldPt,1), UBOUND(InData%map2BldPt,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%map2BldPt(i1), ErrStat2, ErrMsg2, OnlySize ) ! map2BldPt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - END SUBROUTINE AD_Dvr_PackHubData - - SUBROUTINE AD_Dvr_UnPackHubData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(HubData), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_UnPackHubData' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - i1_l = LBOUND(OutData%origin_n,1) - i1_u = UBOUND(OutData%origin_n,1) - DO i1 = LBOUND(OutData%origin_n,1), UBOUND(OutData%origin_n,1) - OutData%origin_n(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%orientation_n,1) - i1_u = UBOUND(OutData%orientation_n,1) - DO i1 = LBOUND(OutData%orientation_n,1), UBOUND(OutData%orientation_n,1) - OutData%orientation_n(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%motionType = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%iMotion = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%azimuth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rotSpeed = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rotAcc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(OutData%motionFileName) - OutData%motionFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! motion not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%motion)) DEALLOCATE(OutData%motion) - ALLOCATE(OutData%motion(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%motion.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%motion,2), UBOUND(OutData%motion,2) - DO i1 = LBOUND(OutData%motion,1), UBOUND(OutData%motion,1) - OutData%motion(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, 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%ptMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! ptMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_AD_P_H, ErrStat2, ErrMsg2 ) ! ED_P_2_AD_P_H - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! map2BldPt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%map2BldPt)) DEALLOCATE(OutData%map2BldPt) - ALLOCATE(OutData%map2BldPt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%map2BldPt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%map2BldPt,1), UBOUND(OutData%map2BldPt,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%map2BldPt(i1), ErrStat2, ErrMsg2 ) ! map2BldPt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - END SUBROUTINE AD_Dvr_UnPackHubData - - SUBROUTINE AD_Dvr_CopyNacData( SrcNacDataData, DstNacDataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(NacData), INTENT(INOUT) :: SrcNacDataData - TYPE(NacData), INTENT(INOUT) :: DstNacDataData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_CopyNacData' -! - ErrStat = ErrID_None - ErrMsg = "" - DstNacDataData%origin_t = SrcNacDataData%origin_t - DstNacDataData%motionType = SrcNacDataData%motionType - DstNacDataData%iMotion = SrcNacDataData%iMotion - DstNacDataData%yaw = SrcNacDataData%yaw - DstNacDataData%yawSpeed = SrcNacDataData%yawSpeed - DstNacDataData%yawAcc = SrcNacDataData%yawAcc - DstNacDataData%motionFileName = SrcNacDataData%motionFileName -IF (ALLOCATED(SrcNacDataData%motion)) THEN - i1_l = LBOUND(SrcNacDataData%motion,1) - i1_u = UBOUND(SrcNacDataData%motion,1) - i2_l = LBOUND(SrcNacDataData%motion,2) - i2_u = UBOUND(SrcNacDataData%motion,2) - IF (.NOT. ALLOCATED(DstNacDataData%motion)) THEN - ALLOCATE(DstNacDataData%motion(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstNacDataData%motion.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstNacDataData%motion = SrcNacDataData%motion -ENDIF - CALL MeshCopy( SrcNacDataData%ptMesh, DstNacDataData%ptMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcNacDataData%ED_P_2_AD_P_N, DstNacDataData%ED_P_2_AD_P_N, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcNacDataData%map2hubPt, DstNacDataData%map2hubPt, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE AD_Dvr_CopyNacData - - SUBROUTINE AD_Dvr_DestroyNacData( NacDataData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(NacData), INTENT(INOUT) :: NacDataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_DestroyNacData' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(NacDataData%motion)) THEN - DEALLOCATE(NacDataData%motion) -ENDIF - CALL MeshDestroy( NacDataData%ptMesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_Destroymeshmaptype( NacDataData%ED_P_2_AD_P_N, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_Destroymeshmaptype( NacDataData%map2hubPt, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AD_Dvr_DestroyNacData - - SUBROUTINE AD_Dvr_PackNacData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(NacData), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_PackNacData' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + SIZE(InData%origin_t) ! origin_t - Int_BufSz = Int_BufSz + 1 ! motionType - Int_BufSz = Int_BufSz + 1 ! iMotion - Re_BufSz = Re_BufSz + 1 ! yaw - Re_BufSz = Re_BufSz + 1 ! yawSpeed - Re_BufSz = Re_BufSz + 1 ! yawAcc - Int_BufSz = Int_BufSz + 1*LEN(InData%motionFileName) ! motionFileName - Int_BufSz = Int_BufSz + 1 ! motion allocated yes/no - IF ( ALLOCATED(InData%motion) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! motion upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%motion) ! motion - END IF - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! ptMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%ptMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! ptMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ptMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ptMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ptMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! ED_P_2_AD_P_N: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_N, ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_AD_P_N - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_AD_P_N - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_AD_P_N - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_AD_P_N - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! map2hubPt: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%map2hubPt, ErrStat2, ErrMsg2, .TRUE. ) ! map2hubPt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! map2hubPt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! map2hubPt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! map2hubPt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO i1 = LBOUND(InData%origin_t,1), UBOUND(InData%origin_t,1) - ReKiBuf(Re_Xferred) = InData%origin_t(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%motionType - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%iMotion - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%yaw - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%yawSpeed - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%yawAcc - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(InData%motionFileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%motionFileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( .NOT. ALLOCATED(InData%motion) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%motion,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%motion,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%motion,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%motion,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%motion,2), UBOUND(InData%motion,2) - DO i1 = LBOUND(InData%motion,1), UBOUND(InData%motion,1) - ReKiBuf(Re_Xferred) = InData%motion(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - CALL MeshPack( InData%ptMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! ptMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_N, ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_AD_P_N - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%map2hubPt, ErrStat2, ErrMsg2, OnlySize ) ! map2hubPt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE AD_Dvr_PackNacData - - SUBROUTINE AD_Dvr_UnPackNacData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(NacData), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_UnPackNacData' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - i1_l = LBOUND(OutData%origin_t,1) - i1_u = UBOUND(OutData%origin_t,1) - DO i1 = LBOUND(OutData%origin_t,1), UBOUND(OutData%origin_t,1) - OutData%origin_t(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%motionType = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%iMotion = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%yaw = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%yawSpeed = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%yawAcc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(OutData%motionFileName) - OutData%motionFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! motion not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%motion)) DEALLOCATE(OutData%motion) - ALLOCATE(OutData%motion(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%motion.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%motion,2), UBOUND(OutData%motion,2) - DO i1 = LBOUND(OutData%motion,1), UBOUND(OutData%motion,1) - OutData%motion(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, 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%ptMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! ptMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_AD_P_N, ErrStat2, ErrMsg2 ) ! ED_P_2_AD_P_N - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%map2hubPt, ErrStat2, ErrMsg2 ) ! map2hubPt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE AD_Dvr_UnPackNacData - - SUBROUTINE AD_Dvr_CopyTwrData( SrcTwrDataData, DstTwrDataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(TwrData), INTENT(INOUT) :: SrcTwrDataData - TYPE(TwrData), INTENT(INOUT) :: DstTwrDataData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_CopyTwrData' -! - ErrStat = ErrID_None - ErrMsg = "" - DstTwrDataData%origin_t = SrcTwrDataData%origin_t - CALL MeshCopy( SrcTwrDataData%ptMesh, DstTwrDataData%ptMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcTwrDataData%ptMeshAD, DstTwrDataData%ptMeshAD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcTwrDataData%ED_P_2_AD_P_T, DstTwrDataData%ED_P_2_AD_P_T, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcTwrDataData%AD_P_2_AD_L_T, DstTwrDataData%AD_P_2_AD_L_T, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE AD_Dvr_CopyTwrData - - SUBROUTINE AD_Dvr_DestroyTwrData( TwrDataData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(TwrData), INTENT(INOUT) :: TwrDataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_DestroyTwrData' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL MeshDestroy( TwrDataData%ptMesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( TwrDataData%ptMeshAD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_Destroymeshmaptype( TwrDataData%ED_P_2_AD_P_T, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_Destroymeshmaptype( TwrDataData%AD_P_2_AD_L_T, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AD_Dvr_DestroyTwrData - - SUBROUTINE AD_Dvr_PackTwrData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(TwrData), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_PackTwrData' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + SIZE(InData%origin_t) ! origin_t - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! ptMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%ptMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! ptMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ptMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ptMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ptMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! ptMeshAD: size of buffers for each call to pack subtype - CALL MeshPack( InData%ptMeshAD, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! ptMeshAD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ptMeshAD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ptMeshAD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ptMeshAD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! ED_P_2_AD_P_T: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_T, ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_AD_P_T - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_AD_P_T - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_AD_P_T - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_AD_P_T - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! AD_P_2_AD_L_T: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%AD_P_2_AD_L_T, ErrStat2, ErrMsg2, .TRUE. ) ! AD_P_2_AD_L_T - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AD_P_2_AD_L_T - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AD_P_2_AD_L_T - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AD_P_2_AD_L_T - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO i1 = LBOUND(InData%origin_t,1), UBOUND(InData%origin_t,1) - ReKiBuf(Re_Xferred) = InData%origin_t(i1) - Re_Xferred = Re_Xferred + 1 - END DO - CALL MeshPack( InData%ptMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! ptMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = 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%ptMeshAD, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! ptMeshAD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_T, ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_AD_P_T - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%AD_P_2_AD_L_T, ErrStat2, ErrMsg2, OnlySize ) ! AD_P_2_AD_L_T - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE AD_Dvr_PackTwrData - - SUBROUTINE AD_Dvr_UnPackTwrData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(TwrData), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_UnPackTwrData' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - i1_l = LBOUND(OutData%origin_t,1) - i1_u = UBOUND(OutData%origin_t,1) - DO i1 = LBOUND(OutData%origin_t,1), UBOUND(OutData%origin_t,1) - OutData%origin_t(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, 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%ptMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! ptMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, 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%ptMeshAD, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! ptMeshAD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_AD_P_T, ErrStat2, ErrMsg2 ) ! ED_P_2_AD_P_T - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%AD_P_2_AD_L_T, ErrStat2, ErrMsg2 ) ! AD_P_2_AD_L_T - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE AD_Dvr_UnPackTwrData - - SUBROUTINE AD_Dvr_CopyWTData( SrcWTDataData, DstWTDataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WTData), INTENT(INOUT) :: SrcWTDataData - TYPE(WTData), INTENT(INOUT) :: DstWTDataData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_CopyWTData' -! - ErrStat = ErrID_None - ErrMsg = "" - DstWTDataData%originInit = SrcWTDataData%originInit - DstWTDataData%orientationInit = SrcWTDataData%orientationInit - CALL MeshCopy( SrcWTDataData%ptMesh, DstWTDataData%ptMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcWTDataData%map2twrPt, DstWTDataData%map2twrPt, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcWTDataData%map2nacPt, DstWTDataData%map2nacPt, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcWTDataData%bld)) THEN - i1_l = LBOUND(SrcWTDataData%bld,1) - i1_u = UBOUND(SrcWTDataData%bld,1) - IF (.NOT. ALLOCATED(DstWTDataData%bld)) THEN - ALLOCATE(DstWTDataData%bld(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWTDataData%bld.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcWTDataData%bld,1), UBOUND(SrcWTDataData%bld,1) - CALL AD_Dvr_Copybladedata( SrcWTDataData%bld(i1), DstWTDataData%bld(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL AD_Dvr_Copyhubdata( SrcWTDataData%hub, DstWTDataData%hub, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD_Dvr_Copynacdata( SrcWTDataData%nac, DstWTDataData%nac, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD_Dvr_Copytwrdata( SrcWTDataData%twr, DstWTDataData%twr, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstWTDataData%numBlades = SrcWTDataData%numBlades - DstWTDataData%basicHAWTFormat = SrcWTDataData%basicHAWTFormat - DstWTDataData%hasTower = SrcWTDataData%hasTower - DstWTDataData%projMod = SrcWTDataData%projMod - DstWTDataData%HAWTprojection = SrcWTDataData%HAWTprojection - DstWTDataData%motionType = SrcWTDataData%motionType -IF (ALLOCATED(SrcWTDataData%motion)) THEN - i1_l = LBOUND(SrcWTDataData%motion,1) - i1_u = UBOUND(SrcWTDataData%motion,1) - i2_l = LBOUND(SrcWTDataData%motion,2) - i2_u = UBOUND(SrcWTDataData%motion,2) - IF (.NOT. ALLOCATED(DstWTDataData%motion)) THEN - ALLOCATE(DstWTDataData%motion(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWTDataData%motion.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWTDataData%motion = SrcWTDataData%motion -ENDIF - DstWTDataData%iMotion = SrcWTDataData%iMotion - DstWTDataData%degreeOfFreedom = SrcWTDataData%degreeOfFreedom - DstWTDataData%amplitude = SrcWTDataData%amplitude - DstWTDataData%frequency = SrcWTDataData%frequency - DstWTDataData%motionFileName = SrcWTDataData%motionFileName -IF (ALLOCATED(SrcWTDataData%WriteOutput)) THEN - i1_l = LBOUND(SrcWTDataData%WriteOutput,1) - i1_u = UBOUND(SrcWTDataData%WriteOutput,1) - IF (.NOT. ALLOCATED(DstWTDataData%WriteOutput)) THEN - ALLOCATE(DstWTDataData%WriteOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWTDataData%WriteOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWTDataData%WriteOutput = SrcWTDataData%WriteOutput -ENDIF - END SUBROUTINE AD_Dvr_CopyWTData - - SUBROUTINE AD_Dvr_DestroyWTData( WTDataData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(WTData), INTENT(INOUT) :: WTDataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_DestroyWTData' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL MeshDestroy( WTDataData%ptMesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_Destroymeshmaptype( WTDataData%map2twrPt, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_Destroymeshmaptype( WTDataData%map2nacPt, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(WTDataData%bld)) THEN -DO i1 = LBOUND(WTDataData%bld,1), UBOUND(WTDataData%bld,1) - CALL AD_Dvr_Destroybladedata( WTDataData%bld(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(WTDataData%bld) -ENDIF - CALL AD_Dvr_Destroyhubdata( WTDataData%hub, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD_Dvr_Destroynacdata( WTDataData%nac, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD_Dvr_Destroytwrdata( WTDataData%twr, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(WTDataData%motion)) THEN - DEALLOCATE(WTDataData%motion) -ENDIF -IF (ALLOCATED(WTDataData%WriteOutput)) THEN - DEALLOCATE(WTDataData%WriteOutput) -ENDIF - END SUBROUTINE AD_Dvr_DestroyWTData - - SUBROUTINE AD_Dvr_PackWTData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(WTData), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_PackWTData' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + SIZE(InData%originInit) ! originInit - Re_BufSz = Re_BufSz + SIZE(InData%orientationInit) ! orientationInit - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! ptMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%ptMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! ptMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ptMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ptMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ptMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! map2twrPt: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%map2twrPt, ErrStat2, ErrMsg2, .TRUE. ) ! map2twrPt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! map2twrPt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! map2twrPt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! map2twrPt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! map2nacPt: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%map2nacPt, ErrStat2, ErrMsg2, .TRUE. ) ! map2nacPt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! map2nacPt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! map2nacPt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! map2nacPt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! bld allocated yes/no - IF ( ALLOCATED(InData%bld) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! bld upper/lower bounds for each dimension - DO i1 = LBOUND(InData%bld,1), UBOUND(InData%bld,1) - Int_BufSz = Int_BufSz + 3 ! bld: size of buffers for each call to pack subtype - CALL AD_Dvr_Packbladedata( Re_Buf, Db_Buf, Int_Buf, InData%bld(i1), ErrStat2, ErrMsg2, .TRUE. ) ! bld - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! bld - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! bld - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! bld - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! hub: size of buffers for each call to pack subtype - CALL AD_Dvr_Packhubdata( Re_Buf, Db_Buf, Int_Buf, InData%hub, ErrStat2, ErrMsg2, .TRUE. ) ! hub - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! hub - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! hub - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! hub - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! nac: size of buffers for each call to pack subtype - CALL AD_Dvr_Packnacdata( Re_Buf, Db_Buf, Int_Buf, InData%nac, ErrStat2, ErrMsg2, .TRUE. ) ! nac - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! nac - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! nac - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! nac - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! twr: size of buffers for each call to pack subtype - CALL AD_Dvr_Packtwrdata( Re_Buf, Db_Buf, Int_Buf, InData%twr, ErrStat2, ErrMsg2, .TRUE. ) ! twr - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! twr - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! twr - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! twr - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! numBlades - Int_BufSz = Int_BufSz + 1 ! basicHAWTFormat - Int_BufSz = Int_BufSz + 1 ! hasTower - Int_BufSz = Int_BufSz + 1 ! projMod - Int_BufSz = Int_BufSz + 1 ! HAWTprojection - Int_BufSz = Int_BufSz + 1 ! motionType - Int_BufSz = Int_BufSz + 1 ! motion allocated yes/no - IF ( ALLOCATED(InData%motion) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! motion upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%motion) ! motion - END IF - Int_BufSz = Int_BufSz + 1 ! iMotion - Int_BufSz = Int_BufSz + 1 ! degreeOfFreedom - Re_BufSz = Re_BufSz + 1 ! amplitude - Re_BufSz = Re_BufSz + 1 ! frequency - Int_BufSz = Int_BufSz + 1*LEN(InData%motionFileName) ! motionFileName - Int_BufSz = Int_BufSz + 1 ! WriteOutput allocated yes/no - IF ( ALLOCATED(InData%WriteOutput) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutput upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WriteOutput) ! WriteOutput - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO i1 = LBOUND(InData%originInit,1), UBOUND(InData%originInit,1) - ReKiBuf(Re_Xferred) = InData%originInit(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%orientationInit,1), UBOUND(InData%orientationInit,1) - ReKiBuf(Re_Xferred) = InData%orientationInit(i1) - Re_Xferred = Re_Xferred + 1 - END DO - CALL MeshPack( InData%ptMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! ptMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = 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%map2twrPt, ErrStat2, ErrMsg2, OnlySize ) ! map2twrPt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%map2nacPt, ErrStat2, ErrMsg2, OnlySize ) ! map2nacPt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%bld) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%bld,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%bld,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%bld,1), UBOUND(InData%bld,1) - CALL AD_Dvr_Packbladedata( Re_Buf, Db_Buf, Int_Buf, InData%bld(i1), ErrStat2, ErrMsg2, OnlySize ) ! bld - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - CALL AD_Dvr_Packhubdata( Re_Buf, Db_Buf, Int_Buf, InData%hub, ErrStat2, ErrMsg2, OnlySize ) ! hub - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL AD_Dvr_Packnacdata( Re_Buf, Db_Buf, Int_Buf, InData%nac, ErrStat2, ErrMsg2, OnlySize ) ! nac - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL AD_Dvr_Packtwrdata( Re_Buf, Db_Buf, Int_Buf, InData%twr, ErrStat2, ErrMsg2, OnlySize ) ! twr - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IntKiBuf(Int_Xferred) = InData%numBlades - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%basicHAWTFormat, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%hasTower, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%projMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%HAWTprojection, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%motionType - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%motion) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%motion,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%motion,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%motion,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%motion,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%motion,2), UBOUND(InData%motion,2) - DO i1 = LBOUND(InData%motion,1), UBOUND(InData%motion,1) - ReKiBuf(Re_Xferred) = InData%motion(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%iMotion - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%degreeOfFreedom - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%amplitude - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%frequency - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(InData%motionFileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%motionFileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( .NOT. ALLOCATED(InData%WriteOutput) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutput,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) - ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE AD_Dvr_PackWTData - - SUBROUTINE AD_Dvr_UnPackWTData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(WTData), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_UnPackWTData' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - i1_l = LBOUND(OutData%originInit,1) - i1_u = UBOUND(OutData%originInit,1) - DO i1 = LBOUND(OutData%originInit,1), UBOUND(OutData%originInit,1) - OutData%originInit(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%orientationInit,1) - i1_u = UBOUND(OutData%orientationInit,1) - DO i1 = LBOUND(OutData%orientationInit,1), UBOUND(OutData%orientationInit,1) - OutData%orientationInit(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%ptMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! ptMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%map2twrPt, ErrStat2, ErrMsg2 ) ! map2twrPt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%map2nacPt, ErrStat2, ErrMsg2 ) ! map2nacPt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! bld not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%bld)) DEALLOCATE(OutData%bld) - ALLOCATE(OutData%bld(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%bld.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%bld,1), UBOUND(OutData%bld,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD_Dvr_Unpackbladedata( Re_Buf, Db_Buf, Int_Buf, OutData%bld(i1), ErrStat2, ErrMsg2 ) ! bld - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD_Dvr_Unpackhubdata( Re_Buf, Db_Buf, Int_Buf, OutData%hub, ErrStat2, ErrMsg2 ) ! hub - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD_Dvr_Unpacknacdata( Re_Buf, Db_Buf, Int_Buf, OutData%nac, ErrStat2, ErrMsg2 ) ! nac - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD_Dvr_Unpacktwrdata( Re_Buf, Db_Buf, Int_Buf, OutData%twr, ErrStat2, ErrMsg2 ) ! twr - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%numBlades = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%basicHAWTFormat = TRANSFER(IntKiBuf(Int_Xferred), OutData%basicHAWTFormat) - Int_Xferred = Int_Xferred + 1 - OutData%hasTower = TRANSFER(IntKiBuf(Int_Xferred), OutData%hasTower) - Int_Xferred = Int_Xferred + 1 - OutData%projMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%HAWTprojection = TRANSFER(IntKiBuf(Int_Xferred), OutData%HAWTprojection) - Int_Xferred = Int_Xferred + 1 - OutData%motionType = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! motion not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%motion)) DEALLOCATE(OutData%motion) - ALLOCATE(OutData%motion(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%motion.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%motion,2), UBOUND(OutData%motion,2) - DO i1 = LBOUND(OutData%motion,1), UBOUND(OutData%motion,1) - OutData%motion(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%iMotion = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%degreeOfFreedom = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%amplitude = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%frequency = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(OutData%motionFileName) - OutData%motionFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutput not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutput)) DEALLOCATE(OutData%WriteOutput) - ALLOCATE(OutData%WriteOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) - OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE AD_Dvr_UnPackWTData - - SUBROUTINE AD_Dvr_CopyDvr_SimData( SrcDvr_SimDataData, DstDvr_SimDataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Dvr_SimData), INTENT(INOUT) :: SrcDvr_SimDataData - TYPE(Dvr_SimData), INTENT(INOUT) :: DstDvr_SimDataData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_CopyDvr_SimData' -! - ErrStat = ErrID_None - ErrMsg = "" - DstDvr_SimDataData%AD_InputFile = SrcDvr_SimDataData%AD_InputFile - DstDvr_SimDataData%IW_InputFile = SrcDvr_SimDataData%IW_InputFile - DstDvr_SimDataData%MHK = SrcDvr_SimDataData%MHK - DstDvr_SimDataData%AnalysisType = SrcDvr_SimDataData%AnalysisType - DstDvr_SimDataData%FldDens = SrcDvr_SimDataData%FldDens - DstDvr_SimDataData%KinVisc = SrcDvr_SimDataData%KinVisc - DstDvr_SimDataData%SpdSound = SrcDvr_SimDataData%SpdSound - DstDvr_SimDataData%Patm = SrcDvr_SimDataData%Patm - DstDvr_SimDataData%Pvap = SrcDvr_SimDataData%Pvap - DstDvr_SimDataData%WtrDpth = SrcDvr_SimDataData%WtrDpth - DstDvr_SimDataData%MSL2SWL = SrcDvr_SimDataData%MSL2SWL - DstDvr_SimDataData%CompInflow = SrcDvr_SimDataData%CompInflow - DstDvr_SimDataData%HWindSpeed = SrcDvr_SimDataData%HWindSpeed - DstDvr_SimDataData%RefHt = SrcDvr_SimDataData%RefHt - DstDvr_SimDataData%PLExp = SrcDvr_SimDataData%PLExp - DstDvr_SimDataData%numTurbines = SrcDvr_SimDataData%numTurbines -IF (ALLOCATED(SrcDvr_SimDataData%WT)) THEN - i1_l = LBOUND(SrcDvr_SimDataData%WT,1) - i1_u = UBOUND(SrcDvr_SimDataData%WT,1) - IF (.NOT. ALLOCATED(DstDvr_SimDataData%WT)) THEN - ALLOCATE(DstDvr_SimDataData%WT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDvr_SimDataData%WT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcDvr_SimDataData%WT,1), UBOUND(SrcDvr_SimDataData%WT,1) - CALL AD_Dvr_Copywtdata( SrcDvr_SimDataData%WT(i1), DstDvr_SimDataData%WT(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstDvr_SimDataData%dT = SrcDvr_SimDataData%dT - DstDvr_SimDataData%tMax = SrcDvr_SimDataData%tMax - DstDvr_SimDataData%numSteps = SrcDvr_SimDataData%numSteps - DstDvr_SimDataData%numCases = SrcDvr_SimDataData%numCases -IF (ALLOCATED(SrcDvr_SimDataData%Cases)) THEN - i1_l = LBOUND(SrcDvr_SimDataData%Cases,1) - i1_u = UBOUND(SrcDvr_SimDataData%Cases,1) - IF (.NOT. ALLOCATED(DstDvr_SimDataData%Cases)) THEN - ALLOCATE(DstDvr_SimDataData%Cases(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDvr_SimDataData%Cases.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcDvr_SimDataData%Cases,1), UBOUND(SrcDvr_SimDataData%Cases,1) - CALL AD_Dvr_Copydvr_case( SrcDvr_SimDataData%Cases(i1), DstDvr_SimDataData%Cases(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstDvr_SimDataData%iCase = SrcDvr_SimDataData%iCase -IF (ALLOCATED(SrcDvr_SimDataData%timeSeries)) THEN - i1_l = LBOUND(SrcDvr_SimDataData%timeSeries,1) - i1_u = UBOUND(SrcDvr_SimDataData%timeSeries,1) - i2_l = LBOUND(SrcDvr_SimDataData%timeSeries,2) - i2_u = UBOUND(SrcDvr_SimDataData%timeSeries,2) - IF (.NOT. ALLOCATED(DstDvr_SimDataData%timeSeries)) THEN - ALLOCATE(DstDvr_SimDataData%timeSeries(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDvr_SimDataData%timeSeries.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDvr_SimDataData%timeSeries = SrcDvr_SimDataData%timeSeries -ENDIF - DstDvr_SimDataData%iTimeSeries = SrcDvr_SimDataData%iTimeSeries - DstDvr_SimDataData%root = SrcDvr_SimDataData%root - CALL AD_Dvr_Copydvr_outputs( SrcDvr_SimDataData%out, DstDvr_SimDataData%out, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE AD_Dvr_CopyDvr_SimData - - SUBROUTINE AD_Dvr_DestroyDvr_SimData( Dvr_SimDataData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Dvr_SimData), INTENT(INOUT) :: Dvr_SimDataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_DestroyDvr_SimData' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(Dvr_SimDataData%WT)) THEN -DO i1 = LBOUND(Dvr_SimDataData%WT,1), UBOUND(Dvr_SimDataData%WT,1) - CALL AD_Dvr_Destroywtdata( Dvr_SimDataData%WT(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(Dvr_SimDataData%WT) -ENDIF -IF (ALLOCATED(Dvr_SimDataData%Cases)) THEN -DO i1 = LBOUND(Dvr_SimDataData%Cases,1), UBOUND(Dvr_SimDataData%Cases,1) - CALL AD_Dvr_Destroydvr_case( Dvr_SimDataData%Cases(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(Dvr_SimDataData%Cases) -ENDIF -IF (ALLOCATED(Dvr_SimDataData%timeSeries)) THEN - DEALLOCATE(Dvr_SimDataData%timeSeries) -ENDIF - CALL AD_Dvr_Destroydvr_outputs( Dvr_SimDataData%out, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AD_Dvr_DestroyDvr_SimData - - SUBROUTINE AD_Dvr_PackDvr_SimData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Dvr_SimData), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_PackDvr_SimData' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1*LEN(InData%AD_InputFile) ! AD_InputFile - Int_BufSz = Int_BufSz + 1*LEN(InData%IW_InputFile) ! IW_InputFile - Int_BufSz = Int_BufSz + 1 ! MHK - Int_BufSz = Int_BufSz + 1 ! AnalysisType - Re_BufSz = Re_BufSz + 1 ! FldDens - Re_BufSz = Re_BufSz + 1 ! KinVisc - Re_BufSz = Re_BufSz + 1 ! SpdSound - Re_BufSz = Re_BufSz + 1 ! Patm - Re_BufSz = Re_BufSz + 1 ! Pvap - Re_BufSz = Re_BufSz + 1 ! WtrDpth - Re_BufSz = Re_BufSz + 1 ! MSL2SWL - Int_BufSz = Int_BufSz + 1 ! CompInflow - Re_BufSz = Re_BufSz + 1 ! HWindSpeed - Re_BufSz = Re_BufSz + 1 ! RefHt - Re_BufSz = Re_BufSz + 1 ! PLExp - Int_BufSz = Int_BufSz + 1 ! numTurbines - Int_BufSz = Int_BufSz + 1 ! WT allocated yes/no - IF ( ALLOCATED(InData%WT) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WT upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%WT,1), UBOUND(InData%WT,1) - Int_BufSz = Int_BufSz + 3 ! WT: size of buffers for each call to pack subtype - CALL AD_Dvr_Packwtdata( Re_Buf, Db_Buf, Int_Buf, InData%WT(i1), ErrStat2, ErrMsg2, .TRUE. ) ! WT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! WT - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! WT - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! WT - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Db_BufSz = Db_BufSz + 1 ! dT - Db_BufSz = Db_BufSz + 1 ! tMax - Int_BufSz = Int_BufSz + 1 ! numSteps - Int_BufSz = Int_BufSz + 1 ! numCases - Int_BufSz = Int_BufSz + 1 ! Cases allocated yes/no - IF ( ALLOCATED(InData%Cases) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Cases upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Cases,1), UBOUND(InData%Cases,1) - Int_BufSz = Int_BufSz + 3 ! Cases: size of buffers for each call to pack subtype - CALL AD_Dvr_Packdvr_case( Re_Buf, Db_Buf, Int_Buf, InData%Cases(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Cases - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Cases - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Cases - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Cases - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! iCase - Int_BufSz = Int_BufSz + 1 ! timeSeries allocated yes/no - IF ( ALLOCATED(InData%timeSeries) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! timeSeries upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%timeSeries) ! timeSeries - END IF - Int_BufSz = Int_BufSz + 1 ! iTimeSeries - Int_BufSz = Int_BufSz + 1*LEN(InData%root) ! root - Int_BufSz = Int_BufSz + 3 ! out: size of buffers for each call to pack subtype - CALL AD_Dvr_Packdvr_outputs( Re_Buf, Db_Buf, Int_Buf, InData%out, ErrStat2, ErrMsg2, .TRUE. ) ! out - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! out - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! out - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! out - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO I = 1, LEN(InData%AD_InputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%AD_InputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%IW_InputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%IW_InputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%MHK - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%AnalysisType - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%FldDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%KinVisc - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SpdSound - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Patm - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Pvap - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MSL2SWL - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%CompInflow - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HWindSpeed - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RefHt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PLExp - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%numTurbines - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WT) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WT,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WT,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WT,1), UBOUND(InData%WT,1) - CALL AD_Dvr_Packwtdata( Re_Buf, Db_Buf, Int_Buf, InData%WT(i1), ErrStat2, ErrMsg2, OnlySize ) ! WT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - DbKiBuf(Db_Xferred) = InData%dT - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%tMax - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%numSteps - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%numCases - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%Cases) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Cases,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cases,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Cases,1), UBOUND(InData%Cases,1) - CALL AD_Dvr_Packdvr_case( Re_Buf, Db_Buf, Int_Buf, InData%Cases(i1), ErrStat2, ErrMsg2, OnlySize ) ! Cases - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IntKiBuf(Int_Xferred) = InData%iCase - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%timeSeries) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%timeSeries,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%timeSeries,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%timeSeries,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%timeSeries,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%timeSeries,2), UBOUND(InData%timeSeries,2) - DO i1 = LBOUND(InData%timeSeries,1), UBOUND(InData%timeSeries,1) - ReKiBuf(Re_Xferred) = InData%timeSeries(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%iTimeSeries - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%root) - IntKiBuf(Int_Xferred) = ICHAR(InData%root(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - CALL AD_Dvr_Packdvr_outputs( Re_Buf, Db_Buf, Int_Buf, InData%out, ErrStat2, ErrMsg2, OnlySize ) ! out - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE AD_Dvr_PackDvr_SimData - - SUBROUTINE AD_Dvr_UnPackDvr_SimData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Dvr_SimData), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_UnPackDvr_SimData' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - DO I = 1, LEN(OutData%AD_InputFile) - OutData%AD_InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%IW_InputFile) - OutData%IW_InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%MHK = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%AnalysisType = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%FldDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%KinVisc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SpdSound = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Patm = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Pvap = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDpth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MSL2SWL = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%CompInflow = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%HWindSpeed = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RefHt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PLExp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%numTurbines = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WT not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WT)) DEALLOCATE(OutData%WT) - ALLOCATE(OutData%WT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WT,1), UBOUND(OutData%WT,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD_Dvr_Unpackwtdata( Re_Buf, Db_Buf, Int_Buf, OutData%WT(i1), ErrStat2, ErrMsg2 ) ! WT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - OutData%dT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%tMax = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%numSteps = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%numCases = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cases not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Cases)) DEALLOCATE(OutData%Cases) - ALLOCATE(OutData%Cases(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cases.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Cases,1), UBOUND(OutData%Cases,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD_Dvr_Unpackdvr_case( Re_Buf, Db_Buf, Int_Buf, OutData%Cases(i1), ErrStat2, ErrMsg2 ) ! Cases - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - OutData%iCase = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! timeSeries not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%timeSeries)) DEALLOCATE(OutData%timeSeries) - ALLOCATE(OutData%timeSeries(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%timeSeries.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%timeSeries,2), UBOUND(OutData%timeSeries,2) - DO i1 = LBOUND(OutData%timeSeries,1), UBOUND(OutData%timeSeries,1) - OutData%timeSeries(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%iTimeSeries = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%root) - OutData%root(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD_Dvr_Unpackdvr_outputs( Re_Buf, Db_Buf, Int_Buf, OutData%out, ErrStat2, ErrMsg2 ) ! out - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE AD_Dvr_UnPackDvr_SimData - - SUBROUTINE AD_Dvr_CopyAllData( SrcAllDataData, DstAllDataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AllData), INTENT(INOUT) :: SrcAllDataData - TYPE(AllData), INTENT(INOUT) :: DstAllDataData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_CopyAllData' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL AD_Dvr_Copydvr_simdata( SrcAllDataData%dvr, DstAllDataData%dvr, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD_Dvr_Copyaerodyn_data( SrcAllDataData%AD, DstAllDataData%AD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD_Dvr_Copyinflowwind_data( SrcAllDataData%IW, DstAllDataData%IW, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstAllDataData%errStat = SrcAllDataData%errStat - DstAllDataData%errMsg = SrcAllDataData%errMsg - DstAllDataData%initialized = SrcAllDataData%initialized - END SUBROUTINE AD_Dvr_CopyAllData - - SUBROUTINE AD_Dvr_DestroyAllData( AllDataData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(AllData), INTENT(INOUT) :: AllDataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_DestroyAllData' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL AD_Dvr_Destroydvr_simdata( AllDataData%dvr, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD_Dvr_Destroyaerodyn_data( AllDataData%AD, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD_Dvr_Destroyinflowwind_data( AllDataData%IW, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AD_Dvr_DestroyAllData - - SUBROUTINE AD_Dvr_PackAllData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(AllData), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_PackAllData' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! dvr: size of buffers for each call to pack subtype - CALL AD_Dvr_Packdvr_simdata( Re_Buf, Db_Buf, Int_Buf, InData%dvr, ErrStat2, ErrMsg2, .TRUE. ) ! dvr - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! dvr - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! dvr - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! dvr - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! AD: size of buffers for each call to pack subtype - CALL AD_Dvr_Packaerodyn_data( Re_Buf, Db_Buf, Int_Buf, InData%AD, ErrStat2, ErrMsg2, .TRUE. ) ! AD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! IW: size of buffers for each call to pack subtype - CALL AD_Dvr_Packinflowwind_data( Re_Buf, Db_Buf, Int_Buf, InData%IW, ErrStat2, ErrMsg2, .TRUE. ) ! IW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! IW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! IW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! IW - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! errStat - Int_BufSz = Int_BufSz + 1*LEN(InData%errMsg) ! errMsg - Int_BufSz = Int_BufSz + 1 ! initialized - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL AD_Dvr_Packdvr_simdata( Re_Buf, Db_Buf, Int_Buf, InData%dvr, ErrStat2, ErrMsg2, OnlySize ) ! dvr - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL AD_Dvr_Packaerodyn_data( Re_Buf, Db_Buf, Int_Buf, InData%AD, ErrStat2, ErrMsg2, OnlySize ) ! AD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL AD_Dvr_Packinflowwind_data( Re_Buf, Db_Buf, Int_Buf, InData%IW, ErrStat2, ErrMsg2, OnlySize ) ! IW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IntKiBuf(Int_Xferred) = InData%errStat - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%errMsg) - IntKiBuf(Int_Xferred) = ICHAR(InData%errMsg(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = TRANSFER(InData%initialized, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE AD_Dvr_PackAllData - - SUBROUTINE AD_Dvr_UnPackAllData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(AllData), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_UnPackAllData' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD_Dvr_Unpackdvr_simdata( Re_Buf, Db_Buf, Int_Buf, OutData%dvr, ErrStat2, ErrMsg2 ) ! dvr - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD_Dvr_Unpackaerodyn_data( Re_Buf, Db_Buf, Int_Buf, OutData%AD, ErrStat2, ErrMsg2 ) ! AD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD_Dvr_Unpackinflowwind_data( Re_Buf, Db_Buf, Int_Buf, OutData%IW, ErrStat2, ErrMsg2 ) ! IW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%errStat = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%errMsg) - OutData%errMsg(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%initialized = TRANSFER(IntKiBuf(Int_Xferred), OutData%initialized) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE AD_Dvr_UnPackAllData - -END MODULE AeroDyn_Driver_Types -!ENDOFREGISTRYGENERATEDFILE +!STARTOFREGISTRYGENERATEDFILE 'AeroDyn_Driver_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 +!********************************************************************************************************************************* +! AeroDyn_Driver_Types +!................................................................................................................................. +! This file is part of AeroDyn_Driver. +! +! 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 AeroDyn_Driver. It also contains copy, destroy, pack, and +!! unpack routines associated with each defined data type. This code is automatically generated by the FAST Registry. +MODULE AeroDyn_Driver_Types +!--------------------------------------------------------------------------------------------------------------------------------- +USE AeroDyn_Inflow_Types +USE NWTC_Library +IMPLICIT NONE +! ========= Dvr_Case ======= + TYPE, PUBLIC :: Dvr_Case + REAL(ReKi) :: HWindSpeed !< Hub wind speed [m/s] + REAL(ReKi) :: PLExp !< Power law wind-shear exponent [-] + REAL(ReKi) :: rotSpeed !< Rotor speed [rad/s] + REAL(ReKi) :: bldPitch !< Pitch angle [rad] + REAL(ReKi) :: nacYaw !< Yaw angle [rad] + REAL(DbKi) :: tMax !< Max time [s] + REAL(DbKi) :: dT !< time increment [s] + INTEGER(IntKi) :: numSteps !< number of steps in this case [-] + INTEGER(IntKi) :: DOF !< Degree of freedom for sinusoidal motion [-] + REAL(ReKi) :: amplitude !< Amplitude for sinusoidal motion (when DOF>0) [-] + REAL(ReKi) :: frequency !< Frequency for sinusoidal motion (when DOF>0) [-] + END TYPE Dvr_Case +! ======================= +! ========= DvrVTK_SurfaceType ======= + TYPE, PUBLIC :: DvrVTK_SurfaceType + INTEGER(IntKi) :: NumSectors !< number of sectors in which to split circles (higher number gives smoother surface) [-] + REAL(SiKi) , DIMENSION(1:3,1:8) :: NacelleBox !< X-Y-Z locations of 8 points that define the nacelle box, relative to the nacelle position [m] + REAL(SiKi) , DIMENSION(1:3,1:8) :: BaseBox !< X-Y-Z locations of 8 points that define the base box [m] + END TYPE DvrVTK_SurfaceType +! ======================= +! ========= Dvr_Outputs ======= + TYPE, PUBLIC :: Dvr_Outputs + TYPE(ProgDesc) :: AD_ver !< AeroDyn version information [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: unOutFile !< unit number for writing output file for each rotor [-] + INTEGER(IntKi) :: ActualChanLen !< Actual length of channels written to text file (less than or equal to ChanLen) [-] + INTEGER(IntKi) :: nDvrOutputs !< Number of outputs for the driver (without AD and IW) [-] + character(20) :: Fmt_t !< Format specifier for time channel [-] + character(25) :: Fmt_a !< Format specifier for each column (including delimiter) [-] + character(1) :: delim !< column delimiter [-] + character(20) :: outFmt !< Format specifier [-] + INTEGER(IntKi) :: fileFmt !< Output format 1=Text, 2=Binary, 3=Both [-] + INTEGER(IntKi) :: wrVTK !< 0= no vtk, 1=init only, 2=animation [-] + INTEGER(IntKi) :: WrVTK_Type !< Flag for VTK output type (1=surface, 2=line, 3=both) [-] + character(1024) :: Root !< Output file rootname [-] + character(1024) :: VTK_OutFileRoot !< Output file rootname for vtk [-] + character(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdr !< Channel headers [-] + character(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< Channel units [-] + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: storage !< nTurbines x nChannel x nTime [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: outLine !< Output line to be written to disk [-] + TYPE(DvrVTK_SurfaceType) , DIMENSION(:), ALLOCATABLE :: VTK_surface !< Data for VTK surface visualization [-] + INTEGER(IntKi) :: VTK_tWidth !< Width of number of files for leading zeros in file name format [-] + INTEGER(IntKi) :: n_VTKTime !< Number of time steps between writing VTK files [-] + REAL(SiKi) :: VTKHubRad !< Hub radius for visualization [m] + REAL(ReKi) , DIMENSION(1:6) :: VTKNacDim !< Nacelle dimensions for visualization [m] + REAL(SiKi) , DIMENSION(1:3) :: VTKRefPoint !< RefPoint for VTK outputs [-] + END TYPE Dvr_Outputs +! ======================= +! ========= BladeData ======= + TYPE, PUBLIC :: BladeData + REAL(ReKi) :: pitch !< rad [-] + REAL(ReKi) :: pitchSpeed !< rad/s [-] + REAL(ReKi) :: pitchAcc !< rad/s/s [-] + REAL(ReKi) , DIMENSION(1:3) :: origin_h !< [-] + REAL(ReKi) , DIMENSION(1:3) :: orientation_h !< [-] + REAL(ReKi) :: hubRad_bl !< [-] + REAL(DbKi) , DIMENSION(1:3,1:3) :: Rh2bl0 !< Rotation matrix blade 2 hub [-] + INTEGER(IntKi) :: motionType !< [-] + INTEGER(IntKi) :: iMotion !< Stored index to optimize time interpolation [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: motion !< [-] + character(1024) :: motionFileName !< [-] + END TYPE BladeData +! ======================= +! ========= HubData ======= + TYPE, PUBLIC :: HubData + REAL(ReKi) , DIMENSION(1:3) :: origin_n !< [-] + REAL(ReKi) , DIMENSION(1:3) :: orientation_n !< [-] + INTEGER(IntKi) :: motionType !< [-] + INTEGER(IntKi) :: iMotion !< Stored index to optimize time interpolation [-] + REAL(ReKi) :: azimuth !< rotor position [rad] + REAL(ReKi) :: rotSpeed !< rotor speed [rad/s] + REAL(ReKi) :: rotAcc !< rotor acceleration [rad/s/s] + character(1024) :: motionFileName !< [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: motion !< [-] + END TYPE HubData +! ======================= +! ========= NacData ======= + TYPE, PUBLIC :: NacData + REAL(ReKi) , DIMENSION(1:3) :: origin_t !< [-] + INTEGER(IntKi) :: motionType !< [-] + INTEGER(IntKi) :: iMotion !< Stored index to optimize time interpolation [-] + REAL(ReKi) :: yaw !< rad [rad] + REAL(ReKi) :: yawSpeed !< yawspeed [rad/s] + REAL(ReKi) :: yawAcc !< yawAcceleration [rad/s^2] + character(1024) :: motionFileName !< [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: motion !< [-] + END TYPE NacData +! ======================= +! ========= TwrData ======= + TYPE, PUBLIC :: TwrData + REAL(ReKi) , DIMENSION(1:3) :: origin_t !< [-] + END TYPE TwrData +! ======================= +! ========= WTData ======= + TYPE, PUBLIC :: WTData + REAL(ReKi) , DIMENSION(1:3) :: originInit !< [-] + REAL(ReKi) , DIMENSION(1:3) :: orientationInit !< [-] + TYPE(MeshMapType) :: map2twrPt !< Mesh mapping from base to tower [-] + TYPE(MeshMapType) :: map2nacPt !< Mesh mapping from base to nacelle [-] + TYPE(MeshMapType) :: map2hubPt !< Mesh mapping from Nacelle to hub [-] + TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: map2BldPt !< Mesh mapping from hub to bld root motion [-] + TYPE(BladeData) , DIMENSION(:), ALLOCATABLE :: bld !< [-] + TYPE(HubData) :: hub !< [-] + TYPE(NacData) :: nac !< [-] + TYPE(TwrData) :: twr !< [-] + INTEGER(IntKi) :: numBlades !< [-] + LOGICAL :: basicHAWTFormat !< If true simply input HubRad/Pitch/Overhang/Cone, otherwise all turbine inputs [-] + LOGICAL :: hasTower !< [-] + INTEGER(IntKi) :: projMod !< If true simply input HubRad/Pitch/Overhang/Cone, otherwise all turbine inputs [-] + LOGICAL :: HAWTprojection !< [-] + INTEGER(IntKi) :: motionType !< [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: motion !< [-] + INTEGER(IntKi) :: iMotion !< Stored index to optimize time interpolation [-] + INTEGER(IntKi) :: degreeOfFreedom !< [-] + REAL(ReKi) :: amplitude !< [-] + REAL(ReKi) :: frequency !< [-] + character(1024) :: motionFileName !< [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WriteOutput !< WriteOutputs of the driver only [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: userSwapArray !< Array to store user data for user-defined functions [-] + END TYPE WTData +! ======================= +! ========= Dvr_SimData ======= + TYPE, PUBLIC :: Dvr_SimData + character(1024) :: AD_InputFile !< Name of AeroDyn input file [-] + INTEGER(IntKi) :: MHK !< MHK turbine type (switch) {0: not an MHK turbine, 1: fixed MHK turbine, 2: floating MHK turbine} [-] + INTEGER(IntKi) :: AnalysisType !< 0=Steady Wind, 1=InflowWind [-] + REAL(ReKi) :: FldDens !< Density of working fluid [kg/m^3] + REAL(ReKi) :: KinVisc !< Kinematic viscosity of working fluid [m^2/s] + REAL(ReKi) :: SpdSound !< Speed of sound in working fluid [m/s] + REAL(ReKi) :: Patm !< Atmospheric pressure [Pa] + REAL(ReKi) :: Pvap !< Vapour pressure of working fluid [Pa] + REAL(ReKi) :: WtrDpth !< Water depth [m] + REAL(ReKi) :: MSL2SWL !< Offset between still-water level and mean sea level [m] + INTEGER(IntKi) :: numTurbines !< number of blades on turbine [-] + TYPE(WTData) , DIMENSION(:), ALLOCATABLE :: WT !< Wind turbine data for driver [-] + REAL(DbKi) :: dT !< time increment [s] + REAL(DbKi) :: tMax !< time increment [s] + INTEGER(IntKi) :: numSteps !< number of steps in this case [-] + INTEGER(IntKi) :: numCases !< number of steps in this case [-] + TYPE(Dvr_Case) , DIMENSION(:), ALLOCATABLE :: Cases !< table of cases to run when AnalysisType=2 [-] + INTEGER(IntKi) :: iCase !< Current Case being run [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: timeSeries !< Times series inputs when AnalysisType=1, 6 columns, Time, WndSpeed, ShearExp, RotSpd, Pitch, Yaw [-] + INTEGER(IntKi) :: iTimeSeries !< Stored index to optimize time interpolation [-] + character(1024) :: root !< Output file rootname [-] + TYPE(Dvr_Outputs) :: out !< data for driver output file [-] + TYPE(ADI_IW_InputData) :: IW_InitInp !< [-] + END TYPE Dvr_SimData +! ======================= +! ========= AllData ======= + TYPE, PUBLIC :: AllData + TYPE(Dvr_SimData) :: dvr !< Driver data [-] + TYPE(ADI_Data) :: ADI !< AeroDyn InflowWind Data [-] + TYPE(FED_Data) :: FED !< Elastic wind turbine data (Fake ElastoDyn) [-] + INTEGER(IntKi) :: errStat !< [-] + character(ErrMsgLen) :: errMsg !< [-] + LOGICAL :: initialized !< [-] + END TYPE AllData +! ======================= +CONTAINS + SUBROUTINE AD_Dvr_CopyDvr_Case( SrcDvr_CaseData, DstDvr_CaseData, CtrlCode, ErrStat, ErrMsg ) + TYPE(Dvr_Case), INTENT(IN) :: SrcDvr_CaseData + TYPE(Dvr_Case), INTENT(INOUT) :: DstDvr_CaseData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_CopyDvr_Case' +! + ErrStat = ErrID_None + ErrMsg = "" + DstDvr_CaseData%HWindSpeed = SrcDvr_CaseData%HWindSpeed + DstDvr_CaseData%PLExp = SrcDvr_CaseData%PLExp + DstDvr_CaseData%rotSpeed = SrcDvr_CaseData%rotSpeed + DstDvr_CaseData%bldPitch = SrcDvr_CaseData%bldPitch + DstDvr_CaseData%nacYaw = SrcDvr_CaseData%nacYaw + DstDvr_CaseData%tMax = SrcDvr_CaseData%tMax + DstDvr_CaseData%dT = SrcDvr_CaseData%dT + DstDvr_CaseData%numSteps = SrcDvr_CaseData%numSteps + DstDvr_CaseData%DOF = SrcDvr_CaseData%DOF + DstDvr_CaseData%amplitude = SrcDvr_CaseData%amplitude + DstDvr_CaseData%frequency = SrcDvr_CaseData%frequency + END SUBROUTINE AD_Dvr_CopyDvr_Case + + SUBROUTINE AD_Dvr_DestroyDvr_Case( Dvr_CaseData, ErrStat, ErrMsg, DEALLOCATEpointers ) + TYPE(Dvr_Case), INTENT(INOUT) :: Dvr_CaseData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + LOGICAL :: DEALLOCATEpointers_local + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_DestroyDvr_Case' + + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + + END SUBROUTINE AD_Dvr_DestroyDvr_Case + + SUBROUTINE AD_Dvr_PackDvr_Case( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(Dvr_Case), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_PackDvr_Case' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Re_BufSz = Re_BufSz + 1 ! HWindSpeed + Re_BufSz = Re_BufSz + 1 ! PLExp + Re_BufSz = Re_BufSz + 1 ! rotSpeed + Re_BufSz = Re_BufSz + 1 ! bldPitch + Re_BufSz = Re_BufSz + 1 ! nacYaw + Db_BufSz = Db_BufSz + 1 ! tMax + Db_BufSz = Db_BufSz + 1 ! dT + Int_BufSz = Int_BufSz + 1 ! numSteps + Int_BufSz = Int_BufSz + 1 ! DOF + Re_BufSz = Re_BufSz + 1 ! amplitude + Re_BufSz = Re_BufSz + 1 ! frequency + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + ReKiBuf(Re_Xferred) = InData%HWindSpeed + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PLExp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%rotSpeed + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%bldPitch + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%nacYaw + Re_Xferred = Re_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%tMax + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%dT + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%numSteps + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%DOF + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%amplitude + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%frequency + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE AD_Dvr_PackDvr_Case + + SUBROUTINE AD_Dvr_UnPackDvr_Case( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(Dvr_Case), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_UnPackDvr_Case' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + OutData%HWindSpeed = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PLExp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%rotSpeed = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%bldPitch = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%nacYaw = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%tMax = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%dT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%numSteps = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%DOF = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%amplitude = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%frequency = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE AD_Dvr_UnPackDvr_Case + + SUBROUTINE AD_Dvr_CopyDvrVTK_SurfaceType( SrcDvrVTK_SurfaceTypeData, DstDvrVTK_SurfaceTypeData, CtrlCode, ErrStat, ErrMsg ) + TYPE(DvrVTK_SurfaceType), INTENT(IN) :: SrcDvrVTK_SurfaceTypeData + TYPE(DvrVTK_SurfaceType), INTENT(INOUT) :: DstDvrVTK_SurfaceTypeData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_CopyDvrVTK_SurfaceType' +! + ErrStat = ErrID_None + ErrMsg = "" + DstDvrVTK_SurfaceTypeData%NumSectors = SrcDvrVTK_SurfaceTypeData%NumSectors + DstDvrVTK_SurfaceTypeData%NacelleBox = SrcDvrVTK_SurfaceTypeData%NacelleBox + DstDvrVTK_SurfaceTypeData%BaseBox = SrcDvrVTK_SurfaceTypeData%BaseBox + END SUBROUTINE AD_Dvr_CopyDvrVTK_SurfaceType + + SUBROUTINE AD_Dvr_DestroyDvrVTK_SurfaceType( DvrVTK_SurfaceTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + TYPE(DvrVTK_SurfaceType), INTENT(INOUT) :: DvrVTK_SurfaceTypeData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + LOGICAL :: DEALLOCATEpointers_local + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_DestroyDvrVTK_SurfaceType' + + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + + END SUBROUTINE AD_Dvr_DestroyDvrVTK_SurfaceType + + SUBROUTINE AD_Dvr_PackDvrVTK_SurfaceType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(DvrVTK_SurfaceType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_PackDvrVTK_SurfaceType' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1 ! NumSectors + Re_BufSz = Re_BufSz + SIZE(InData%NacelleBox) ! NacelleBox + Re_BufSz = Re_BufSz + SIZE(InData%BaseBox) ! BaseBox + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + IntKiBuf(Int_Xferred) = InData%NumSectors + Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(InData%NacelleBox,2), UBOUND(InData%NacelleBox,2) + DO i1 = LBOUND(InData%NacelleBox,1), UBOUND(InData%NacelleBox,1) + ReKiBuf(Re_Xferred) = InData%NacelleBox(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i2 = LBOUND(InData%BaseBox,2), UBOUND(InData%BaseBox,2) + DO i1 = LBOUND(InData%BaseBox,1), UBOUND(InData%BaseBox,1) + ReKiBuf(Re_Xferred) = InData%BaseBox(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END SUBROUTINE AD_Dvr_PackDvrVTK_SurfaceType + + SUBROUTINE AD_Dvr_UnPackDvrVTK_SurfaceType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(DvrVTK_SurfaceType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_UnPackDvrVTK_SurfaceType' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + OutData%NumSectors = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + i1_l = LBOUND(OutData%NacelleBox,1) + i1_u = UBOUND(OutData%NacelleBox,1) + i2_l = LBOUND(OutData%NacelleBox,2) + i2_u = UBOUND(OutData%NacelleBox,2) + DO i2 = LBOUND(OutData%NacelleBox,2), UBOUND(OutData%NacelleBox,2) + DO i1 = LBOUND(OutData%NacelleBox,1), UBOUND(OutData%NacelleBox,1) + OutData%NacelleBox(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + i1_l = LBOUND(OutData%BaseBox,1) + i1_u = UBOUND(OutData%BaseBox,1) + i2_l = LBOUND(OutData%BaseBox,2) + i2_u = UBOUND(OutData%BaseBox,2) + DO i2 = LBOUND(OutData%BaseBox,2), UBOUND(OutData%BaseBox,2) + DO i1 = LBOUND(OutData%BaseBox,1), UBOUND(OutData%BaseBox,1) + OutData%BaseBox(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END SUBROUTINE AD_Dvr_UnPackDvrVTK_SurfaceType + + SUBROUTINE AD_Dvr_CopyDvr_Outputs( SrcDvr_OutputsData, DstDvr_OutputsData, CtrlCode, ErrStat, ErrMsg ) + TYPE(Dvr_Outputs), INTENT(IN) :: SrcDvr_OutputsData + TYPE(Dvr_Outputs), INTENT(INOUT) :: DstDvr_OutputsData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_CopyDvr_Outputs' +! + ErrStat = ErrID_None + ErrMsg = "" + CALL NWTC_Library_Copyprogdesc( SrcDvr_OutputsData%AD_ver, DstDvr_OutputsData%AD_ver, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcDvr_OutputsData%unOutFile)) THEN + i1_l = LBOUND(SrcDvr_OutputsData%unOutFile,1) + i1_u = UBOUND(SrcDvr_OutputsData%unOutFile,1) + IF (.NOT. ALLOCATED(DstDvr_OutputsData%unOutFile)) THEN + ALLOCATE(DstDvr_OutputsData%unOutFile(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDvr_OutputsData%unOutFile.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstDvr_OutputsData%unOutFile = SrcDvr_OutputsData%unOutFile +ENDIF + DstDvr_OutputsData%ActualChanLen = SrcDvr_OutputsData%ActualChanLen + DstDvr_OutputsData%nDvrOutputs = SrcDvr_OutputsData%nDvrOutputs + DstDvr_OutputsData%Fmt_t = SrcDvr_OutputsData%Fmt_t + DstDvr_OutputsData%Fmt_a = SrcDvr_OutputsData%Fmt_a + DstDvr_OutputsData%delim = SrcDvr_OutputsData%delim + DstDvr_OutputsData%outFmt = SrcDvr_OutputsData%outFmt + DstDvr_OutputsData%fileFmt = SrcDvr_OutputsData%fileFmt + DstDvr_OutputsData%wrVTK = SrcDvr_OutputsData%wrVTK + DstDvr_OutputsData%WrVTK_Type = SrcDvr_OutputsData%WrVTK_Type + DstDvr_OutputsData%Root = SrcDvr_OutputsData%Root + DstDvr_OutputsData%VTK_OutFileRoot = SrcDvr_OutputsData%VTK_OutFileRoot +IF (ALLOCATED(SrcDvr_OutputsData%WriteOutputHdr)) THEN + i1_l = LBOUND(SrcDvr_OutputsData%WriteOutputHdr,1) + i1_u = UBOUND(SrcDvr_OutputsData%WriteOutputHdr,1) + IF (.NOT. ALLOCATED(DstDvr_OutputsData%WriteOutputHdr)) THEN + ALLOCATE(DstDvr_OutputsData%WriteOutputHdr(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDvr_OutputsData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstDvr_OutputsData%WriteOutputHdr = SrcDvr_OutputsData%WriteOutputHdr +ENDIF +IF (ALLOCATED(SrcDvr_OutputsData%WriteOutputUnt)) THEN + i1_l = LBOUND(SrcDvr_OutputsData%WriteOutputUnt,1) + i1_u = UBOUND(SrcDvr_OutputsData%WriteOutputUnt,1) + IF (.NOT. ALLOCATED(DstDvr_OutputsData%WriteOutputUnt)) THEN + ALLOCATE(DstDvr_OutputsData%WriteOutputUnt(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDvr_OutputsData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstDvr_OutputsData%WriteOutputUnt = SrcDvr_OutputsData%WriteOutputUnt +ENDIF +IF (ALLOCATED(SrcDvr_OutputsData%storage)) THEN + i1_l = LBOUND(SrcDvr_OutputsData%storage,1) + i1_u = UBOUND(SrcDvr_OutputsData%storage,1) + i2_l = LBOUND(SrcDvr_OutputsData%storage,2) + i2_u = UBOUND(SrcDvr_OutputsData%storage,2) + i3_l = LBOUND(SrcDvr_OutputsData%storage,3) + i3_u = UBOUND(SrcDvr_OutputsData%storage,3) + IF (.NOT. ALLOCATED(DstDvr_OutputsData%storage)) THEN + ALLOCATE(DstDvr_OutputsData%storage(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDvr_OutputsData%storage.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstDvr_OutputsData%storage = SrcDvr_OutputsData%storage +ENDIF +IF (ALLOCATED(SrcDvr_OutputsData%outLine)) THEN + i1_l = LBOUND(SrcDvr_OutputsData%outLine,1) + i1_u = UBOUND(SrcDvr_OutputsData%outLine,1) + IF (.NOT. ALLOCATED(DstDvr_OutputsData%outLine)) THEN + ALLOCATE(DstDvr_OutputsData%outLine(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDvr_OutputsData%outLine.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstDvr_OutputsData%outLine = SrcDvr_OutputsData%outLine +ENDIF +IF (ALLOCATED(SrcDvr_OutputsData%VTK_surface)) THEN + i1_l = LBOUND(SrcDvr_OutputsData%VTK_surface,1) + i1_u = UBOUND(SrcDvr_OutputsData%VTK_surface,1) + IF (.NOT. ALLOCATED(DstDvr_OutputsData%VTK_surface)) THEN + ALLOCATE(DstDvr_OutputsData%VTK_surface(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDvr_OutputsData%VTK_surface.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcDvr_OutputsData%VTK_surface,1), UBOUND(SrcDvr_OutputsData%VTK_surface,1) + CALL AD_Dvr_Copydvrvtk_surfacetype( SrcDvr_OutputsData%VTK_surface(i1), DstDvr_OutputsData%VTK_surface(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF + DstDvr_OutputsData%VTK_tWidth = SrcDvr_OutputsData%VTK_tWidth + DstDvr_OutputsData%n_VTKTime = SrcDvr_OutputsData%n_VTKTime + DstDvr_OutputsData%VTKHubRad = SrcDvr_OutputsData%VTKHubRad + DstDvr_OutputsData%VTKNacDim = SrcDvr_OutputsData%VTKNacDim + DstDvr_OutputsData%VTKRefPoint = SrcDvr_OutputsData%VTKRefPoint + END SUBROUTINE AD_Dvr_CopyDvr_Outputs + + SUBROUTINE AD_Dvr_DestroyDvr_Outputs( Dvr_OutputsData, ErrStat, ErrMsg, DEALLOCATEpointers ) + TYPE(Dvr_Outputs), INTENT(INOUT) :: Dvr_OutputsData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + LOGICAL :: DEALLOCATEpointers_local + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_DestroyDvr_Outputs' + + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + + CALL NWTC_Library_Destroyprogdesc( Dvr_OutputsData%AD_ver, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +IF (ALLOCATED(Dvr_OutputsData%unOutFile)) THEN + DEALLOCATE(Dvr_OutputsData%unOutFile) +ENDIF +IF (ALLOCATED(Dvr_OutputsData%WriteOutputHdr)) THEN + DEALLOCATE(Dvr_OutputsData%WriteOutputHdr) +ENDIF +IF (ALLOCATED(Dvr_OutputsData%WriteOutputUnt)) THEN + DEALLOCATE(Dvr_OutputsData%WriteOutputUnt) +ENDIF +IF (ALLOCATED(Dvr_OutputsData%storage)) THEN + DEALLOCATE(Dvr_OutputsData%storage) +ENDIF +IF (ALLOCATED(Dvr_OutputsData%outLine)) THEN + DEALLOCATE(Dvr_OutputsData%outLine) +ENDIF +IF (ALLOCATED(Dvr_OutputsData%VTK_surface)) THEN +DO i1 = LBOUND(Dvr_OutputsData%VTK_surface,1), UBOUND(Dvr_OutputsData%VTK_surface,1) + CALL AD_Dvr_Destroydvrvtk_surfacetype( Dvr_OutputsData%VTK_surface(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(Dvr_OutputsData%VTK_surface) +ENDIF + END SUBROUTINE AD_Dvr_DestroyDvr_Outputs + + SUBROUTINE AD_Dvr_PackDvr_Outputs( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(Dvr_Outputs), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_PackDvr_Outputs' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + Int_BufSz = Int_BufSz + 3 ! AD_ver: size of buffers for each call to pack subtype + CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%AD_ver, ErrStat2, ErrMsg2, .TRUE. ) ! AD_ver + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! AD_ver + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! AD_ver + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! AD_ver + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 1 ! unOutFile allocated yes/no + IF ( ALLOCATED(InData%unOutFile) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! unOutFile upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%unOutFile) ! unOutFile + END IF + Int_BufSz = Int_BufSz + 1 ! ActualChanLen + Int_BufSz = Int_BufSz + 1 ! nDvrOutputs + Int_BufSz = Int_BufSz + 1*LEN(InData%Fmt_t) ! Fmt_t + Int_BufSz = Int_BufSz + 1*LEN(InData%Fmt_a) ! Fmt_a + Int_BufSz = Int_BufSz + 1*LEN(InData%delim) ! delim + Int_BufSz = Int_BufSz + 1*LEN(InData%outFmt) ! outFmt + Int_BufSz = Int_BufSz + 1 ! fileFmt + Int_BufSz = Int_BufSz + 1 ! wrVTK + Int_BufSz = Int_BufSz + 1 ! WrVTK_Type + Int_BufSz = Int_BufSz + 1*LEN(InData%Root) ! Root + Int_BufSz = Int_BufSz + 1*LEN(InData%VTK_OutFileRoot) ! VTK_OutFileRoot + Int_BufSz = Int_BufSz + 1 ! WriteOutputHdr allocated yes/no + IF ( ALLOCATED(InData%WriteOutputHdr) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! WriteOutputHdr upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputHdr)*LEN(InData%WriteOutputHdr) ! WriteOutputHdr + END IF + Int_BufSz = Int_BufSz + 1 ! WriteOutputUnt allocated yes/no + IF ( ALLOCATED(InData%WriteOutputUnt) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! WriteOutputUnt upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputUnt)*LEN(InData%WriteOutputUnt) ! WriteOutputUnt + END IF + Int_BufSz = Int_BufSz + 1 ! storage allocated yes/no + IF ( ALLOCATED(InData%storage) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! storage upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%storage) ! storage + END IF + Int_BufSz = Int_BufSz + 1 ! outLine allocated yes/no + IF ( ALLOCATED(InData%outLine) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! outLine upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%outLine) ! outLine + END IF + Int_BufSz = Int_BufSz + 1 ! VTK_surface allocated yes/no + IF ( ALLOCATED(InData%VTK_surface) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! VTK_surface upper/lower bounds for each dimension + DO i1 = LBOUND(InData%VTK_surface,1), UBOUND(InData%VTK_surface,1) + Int_BufSz = Int_BufSz + 3 ! VTK_surface: size of buffers for each call to pack subtype + CALL AD_Dvr_Packdvrvtk_surfacetype( Re_Buf, Db_Buf, Int_Buf, InData%VTK_surface(i1), ErrStat2, ErrMsg2, .TRUE. ) ! VTK_surface + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! VTK_surface + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! VTK_surface + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! VTK_surface + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! VTK_tWidth + Int_BufSz = Int_BufSz + 1 ! n_VTKTime + Re_BufSz = Re_BufSz + 1 ! VTKHubRad + Re_BufSz = Re_BufSz + SIZE(InData%VTKNacDim) ! VTKNacDim + Re_BufSz = Re_BufSz + SIZE(InData%VTKRefPoint) ! VTKRefPoint + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%AD_ver, ErrStat2, ErrMsg2, OnlySize ) ! AD_ver + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF ( .NOT. ALLOCATED(InData%unOutFile) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%unOutFile,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%unOutFile,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%unOutFile,1), UBOUND(InData%unOutFile,1) + IntKiBuf(Int_Xferred) = InData%unOutFile(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IntKiBuf(Int_Xferred) = InData%ActualChanLen + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nDvrOutputs + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%Fmt_t) + IntKiBuf(Int_Xferred) = ICHAR(InData%Fmt_t(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%Fmt_a) + IntKiBuf(Int_Xferred) = ICHAR(InData%Fmt_a(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%delim) + IntKiBuf(Int_Xferred) = ICHAR(InData%delim(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%outFmt) + IntKiBuf(Int_Xferred) = ICHAR(InData%outFmt(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%fileFmt + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%wrVTK + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%WrVTK_Type + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%Root) + IntKiBuf(Int_Xferred) = ICHAR(InData%Root(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%VTK_OutFileRoot) + IntKiBuf(Int_Xferred) = ICHAR(InData%VTK_OutFileRoot(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IF ( .NOT. ALLOCATED(InData%WriteOutputHdr) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputHdr,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) + DO I = 1, LEN(InData%WriteOutputHdr) + IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputHdr(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputUnt,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) + DO I = 1, LEN(InData%WriteOutputUnt) + IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputUnt(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( .NOT. ALLOCATED(InData%storage) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%storage,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%storage,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%storage,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%storage,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%storage,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%storage,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%storage,3), UBOUND(InData%storage,3) + DO i2 = LBOUND(InData%storage,2), UBOUND(InData%storage,2) + DO i1 = LBOUND(InData%storage,1), UBOUND(InData%storage,1) + ReKiBuf(Re_Xferred) = InData%storage(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%outLine) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%outLine,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%outLine,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%outLine,1), UBOUND(InData%outLine,1) + ReKiBuf(Re_Xferred) = InData%outLine(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%VTK_surface) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%VTK_surface,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VTK_surface,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%VTK_surface,1), UBOUND(InData%VTK_surface,1) + CALL AD_Dvr_Packdvrvtk_surfacetype( Re_Buf, Db_Buf, Int_Buf, InData%VTK_surface(i1), ErrStat2, ErrMsg2, OnlySize ) ! VTK_surface + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IntKiBuf(Int_Xferred) = InData%VTK_tWidth + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%n_VTKTime + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%VTKHubRad + Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%VTKNacDim,1), UBOUND(InData%VTKNacDim,1) + ReKiBuf(Re_Xferred) = InData%VTKNacDim(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%VTKRefPoint,1), UBOUND(InData%VTKRefPoint,1) + ReKiBuf(Re_Xferred) = InData%VTKRefPoint(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END SUBROUTINE AD_Dvr_PackDvr_Outputs + + SUBROUTINE AD_Dvr_UnPackDvr_Outputs( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(Dvr_Outputs), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_UnPackDvr_Outputs' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackprogdesc( Re_Buf, Db_Buf, Int_Buf, OutData%AD_ver, ErrStat2, ErrMsg2 ) ! AD_ver + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! unOutFile not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%unOutFile)) DEALLOCATE(OutData%unOutFile) + ALLOCATE(OutData%unOutFile(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%unOutFile.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%unOutFile,1), UBOUND(OutData%unOutFile,1) + OutData%unOutFile(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + OutData%ActualChanLen = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%nDvrOutputs = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%Fmt_t) + OutData%Fmt_t(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%Fmt_a) + OutData%Fmt_a(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%delim) + OutData%delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%outFmt) + OutData%outFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%fileFmt = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%wrVTK = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%WrVTK_Type = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%Root) + OutData%Root(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%VTK_OutFileRoot) + OutData%VTK_OutFileRoot(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputHdr not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WriteOutputHdr)) DEALLOCATE(OutData%WriteOutputHdr) + ALLOCATE(OutData%WriteOutputHdr(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) + DO I = 1, LEN(OutData%WriteOutputHdr) + OutData%WriteOutputHdr(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WriteOutputUnt)) DEALLOCATE(OutData%WriteOutputUnt) + ALLOCATE(OutData%WriteOutputUnt(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) + DO I = 1, LEN(OutData%WriteOutputUnt) + OutData%WriteOutputUnt(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! storage not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%storage)) DEALLOCATE(OutData%storage) + ALLOCATE(OutData%storage(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%storage.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%storage,3), UBOUND(OutData%storage,3) + DO i2 = LBOUND(OutData%storage,2), UBOUND(OutData%storage,2) + DO i1 = LBOUND(OutData%storage,1), UBOUND(OutData%storage,1) + OutData%storage(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! outLine not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%outLine)) DEALLOCATE(OutData%outLine) + ALLOCATE(OutData%outLine(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%outLine.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%outLine,1), UBOUND(OutData%outLine,1) + OutData%outLine(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! VTK_surface not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%VTK_surface)) DEALLOCATE(OutData%VTK_surface) + ALLOCATE(OutData%VTK_surface(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%VTK_surface.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%VTK_surface,1), UBOUND(OutData%VTK_surface,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL AD_Dvr_Unpackdvrvtk_surfacetype( Re_Buf, Db_Buf, Int_Buf, OutData%VTK_surface(i1), ErrStat2, ErrMsg2 ) ! VTK_surface + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + OutData%VTK_tWidth = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%n_VTKTime = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%VTKHubRad = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + i1_l = LBOUND(OutData%VTKNacDim,1) + i1_u = UBOUND(OutData%VTKNacDim,1) + DO i1 = LBOUND(OutData%VTKNacDim,1), UBOUND(OutData%VTKNacDim,1) + OutData%VTKNacDim(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + i1_l = LBOUND(OutData%VTKRefPoint,1) + i1_u = UBOUND(OutData%VTKRefPoint,1) + DO i1 = LBOUND(OutData%VTKRefPoint,1), UBOUND(OutData%VTKRefPoint,1) + OutData%VTKRefPoint(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END SUBROUTINE AD_Dvr_UnPackDvr_Outputs + + SUBROUTINE AD_Dvr_CopyBladeData( SrcBladeDataData, DstBladeDataData, CtrlCode, ErrStat, ErrMsg ) + TYPE(BladeData), INTENT(IN) :: SrcBladeDataData + TYPE(BladeData), INTENT(INOUT) :: DstBladeDataData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_CopyBladeData' +! + ErrStat = ErrID_None + ErrMsg = "" + DstBladeDataData%pitch = SrcBladeDataData%pitch + DstBladeDataData%pitchSpeed = SrcBladeDataData%pitchSpeed + DstBladeDataData%pitchAcc = SrcBladeDataData%pitchAcc + DstBladeDataData%origin_h = SrcBladeDataData%origin_h + DstBladeDataData%orientation_h = SrcBladeDataData%orientation_h + DstBladeDataData%hubRad_bl = SrcBladeDataData%hubRad_bl + DstBladeDataData%Rh2bl0 = SrcBladeDataData%Rh2bl0 + DstBladeDataData%motionType = SrcBladeDataData%motionType + DstBladeDataData%iMotion = SrcBladeDataData%iMotion +IF (ALLOCATED(SrcBladeDataData%motion)) THEN + i1_l = LBOUND(SrcBladeDataData%motion,1) + i1_u = UBOUND(SrcBladeDataData%motion,1) + i2_l = LBOUND(SrcBladeDataData%motion,2) + i2_u = UBOUND(SrcBladeDataData%motion,2) + IF (.NOT. ALLOCATED(DstBladeDataData%motion)) THEN + ALLOCATE(DstBladeDataData%motion(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladeDataData%motion.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstBladeDataData%motion = SrcBladeDataData%motion +ENDIF + DstBladeDataData%motionFileName = SrcBladeDataData%motionFileName + END SUBROUTINE AD_Dvr_CopyBladeData + + SUBROUTINE AD_Dvr_DestroyBladeData( BladeDataData, ErrStat, ErrMsg, DEALLOCATEpointers ) + TYPE(BladeData), INTENT(INOUT) :: BladeDataData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + LOGICAL :: DEALLOCATEpointers_local + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_DestroyBladeData' + + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + +IF (ALLOCATED(BladeDataData%motion)) THEN + DEALLOCATE(BladeDataData%motion) +ENDIF + END SUBROUTINE AD_Dvr_DestroyBladeData + + SUBROUTINE AD_Dvr_PackBladeData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(BladeData), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_PackBladeData' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Re_BufSz = Re_BufSz + 1 ! pitch + Re_BufSz = Re_BufSz + 1 ! pitchSpeed + Re_BufSz = Re_BufSz + 1 ! pitchAcc + Re_BufSz = Re_BufSz + SIZE(InData%origin_h) ! origin_h + Re_BufSz = Re_BufSz + SIZE(InData%orientation_h) ! orientation_h + Re_BufSz = Re_BufSz + 1 ! hubRad_bl + Db_BufSz = Db_BufSz + SIZE(InData%Rh2bl0) ! Rh2bl0 + Int_BufSz = Int_BufSz + 1 ! motionType + Int_BufSz = Int_BufSz + 1 ! iMotion + Int_BufSz = Int_BufSz + 1 ! motion allocated yes/no + IF ( ALLOCATED(InData%motion) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! motion upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%motion) ! motion + END IF + Int_BufSz = Int_BufSz + 1*LEN(InData%motionFileName) ! motionFileName + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + ReKiBuf(Re_Xferred) = InData%pitch + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%pitchSpeed + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%pitchAcc + Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%origin_h,1), UBOUND(InData%origin_h,1) + ReKiBuf(Re_Xferred) = InData%origin_h(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%orientation_h,1), UBOUND(InData%orientation_h,1) + ReKiBuf(Re_Xferred) = InData%orientation_h(i1) + Re_Xferred = Re_Xferred + 1 + END DO + ReKiBuf(Re_Xferred) = InData%hubRad_bl + Re_Xferred = Re_Xferred + 1 + DO i2 = LBOUND(InData%Rh2bl0,2), UBOUND(InData%Rh2bl0,2) + DO i1 = LBOUND(InData%Rh2bl0,1), UBOUND(InData%Rh2bl0,1) + DbKiBuf(Db_Xferred) = InData%Rh2bl0(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + IntKiBuf(Int_Xferred) = InData%motionType + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%iMotion + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%motion) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%motion,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%motion,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%motion,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%motion,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%motion,2), UBOUND(InData%motion,2) + DO i1 = LBOUND(InData%motion,1), UBOUND(InData%motion,1) + ReKiBuf(Re_Xferred) = InData%motion(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + DO I = 1, LEN(InData%motionFileName) + IntKiBuf(Int_Xferred) = ICHAR(InData%motionFileName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END SUBROUTINE AD_Dvr_PackBladeData + + SUBROUTINE AD_Dvr_UnPackBladeData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(BladeData), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_UnPackBladeData' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + OutData%pitch = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%pitchSpeed = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%pitchAcc = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + i1_l = LBOUND(OutData%origin_h,1) + i1_u = UBOUND(OutData%origin_h,1) + DO i1 = LBOUND(OutData%origin_h,1), UBOUND(OutData%origin_h,1) + OutData%origin_h(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + i1_l = LBOUND(OutData%orientation_h,1) + i1_u = UBOUND(OutData%orientation_h,1) + DO i1 = LBOUND(OutData%orientation_h,1), UBOUND(OutData%orientation_h,1) + OutData%orientation_h(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%hubRad_bl = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + i1_l = LBOUND(OutData%Rh2bl0,1) + i1_u = UBOUND(OutData%Rh2bl0,1) + i2_l = LBOUND(OutData%Rh2bl0,2) + i2_u = UBOUND(OutData%Rh2bl0,2) + DO i2 = LBOUND(OutData%Rh2bl0,2), UBOUND(OutData%Rh2bl0,2) + DO i1 = LBOUND(OutData%Rh2bl0,1), UBOUND(OutData%Rh2bl0,1) + OutData%Rh2bl0(i1,i2) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + OutData%motionType = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%iMotion = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! motion not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%motion)) DEALLOCATE(OutData%motion) + ALLOCATE(OutData%motion(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%motion.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%motion,2), UBOUND(OutData%motion,2) + DO i1 = LBOUND(OutData%motion,1), UBOUND(OutData%motion,1) + OutData%motion(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + DO I = 1, LEN(OutData%motionFileName) + OutData%motionFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END SUBROUTINE AD_Dvr_UnPackBladeData + + SUBROUTINE AD_Dvr_CopyHubData( SrcHubDataData, DstHubDataData, CtrlCode, ErrStat, ErrMsg ) + TYPE(HubData), INTENT(IN) :: SrcHubDataData + TYPE(HubData), INTENT(INOUT) :: DstHubDataData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_CopyHubData' +! + ErrStat = ErrID_None + ErrMsg = "" + DstHubDataData%origin_n = SrcHubDataData%origin_n + DstHubDataData%orientation_n = SrcHubDataData%orientation_n + DstHubDataData%motionType = SrcHubDataData%motionType + DstHubDataData%iMotion = SrcHubDataData%iMotion + DstHubDataData%azimuth = SrcHubDataData%azimuth + DstHubDataData%rotSpeed = SrcHubDataData%rotSpeed + DstHubDataData%rotAcc = SrcHubDataData%rotAcc + DstHubDataData%motionFileName = SrcHubDataData%motionFileName +IF (ALLOCATED(SrcHubDataData%motion)) THEN + i1_l = LBOUND(SrcHubDataData%motion,1) + i1_u = UBOUND(SrcHubDataData%motion,1) + i2_l = LBOUND(SrcHubDataData%motion,2) + i2_u = UBOUND(SrcHubDataData%motion,2) + IF (.NOT. ALLOCATED(DstHubDataData%motion)) THEN + ALLOCATE(DstHubDataData%motion(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstHubDataData%motion.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstHubDataData%motion = SrcHubDataData%motion +ENDIF + END SUBROUTINE AD_Dvr_CopyHubData + + SUBROUTINE AD_Dvr_DestroyHubData( HubDataData, ErrStat, ErrMsg, DEALLOCATEpointers ) + TYPE(HubData), INTENT(INOUT) :: HubDataData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + LOGICAL :: DEALLOCATEpointers_local + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_DestroyHubData' + + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + +IF (ALLOCATED(HubDataData%motion)) THEN + DEALLOCATE(HubDataData%motion) +ENDIF + END SUBROUTINE AD_Dvr_DestroyHubData + + SUBROUTINE AD_Dvr_PackHubData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(HubData), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_PackHubData' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Re_BufSz = Re_BufSz + SIZE(InData%origin_n) ! origin_n + Re_BufSz = Re_BufSz + SIZE(InData%orientation_n) ! orientation_n + Int_BufSz = Int_BufSz + 1 ! motionType + Int_BufSz = Int_BufSz + 1 ! iMotion + Re_BufSz = Re_BufSz + 1 ! azimuth + Re_BufSz = Re_BufSz + 1 ! rotSpeed + Re_BufSz = Re_BufSz + 1 ! rotAcc + Int_BufSz = Int_BufSz + 1*LEN(InData%motionFileName) ! motionFileName + Int_BufSz = Int_BufSz + 1 ! motion allocated yes/no + IF ( ALLOCATED(InData%motion) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! motion upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%motion) ! motion + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + DO i1 = LBOUND(InData%origin_n,1), UBOUND(InData%origin_n,1) + ReKiBuf(Re_Xferred) = InData%origin_n(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%orientation_n,1), UBOUND(InData%orientation_n,1) + ReKiBuf(Re_Xferred) = InData%orientation_n(i1) + Re_Xferred = Re_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%motionType + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%iMotion + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%azimuth + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%rotSpeed + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%rotAcc + Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(InData%motionFileName) + IntKiBuf(Int_Xferred) = ICHAR(InData%motionFileName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IF ( .NOT. ALLOCATED(InData%motion) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%motion,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%motion,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%motion,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%motion,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%motion,2), UBOUND(InData%motion,2) + DO i1 = LBOUND(InData%motion,1), UBOUND(InData%motion,1) + ReKiBuf(Re_Xferred) = InData%motion(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + END SUBROUTINE AD_Dvr_PackHubData + + SUBROUTINE AD_Dvr_UnPackHubData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(HubData), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_UnPackHubData' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + i1_l = LBOUND(OutData%origin_n,1) + i1_u = UBOUND(OutData%origin_n,1) + DO i1 = LBOUND(OutData%origin_n,1), UBOUND(OutData%origin_n,1) + OutData%origin_n(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + i1_l = LBOUND(OutData%orientation_n,1) + i1_u = UBOUND(OutData%orientation_n,1) + DO i1 = LBOUND(OutData%orientation_n,1), UBOUND(OutData%orientation_n,1) + OutData%orientation_n(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%motionType = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%iMotion = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%azimuth = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%rotSpeed = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%rotAcc = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(OutData%motionFileName) + OutData%motionFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! motion not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%motion)) DEALLOCATE(OutData%motion) + ALLOCATE(OutData%motion(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%motion.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%motion,2), UBOUND(OutData%motion,2) + DO i1 = LBOUND(OutData%motion,1), UBOUND(OutData%motion,1) + OutData%motion(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + END SUBROUTINE AD_Dvr_UnPackHubData + + SUBROUTINE AD_Dvr_CopyNacData( SrcNacDataData, DstNacDataData, CtrlCode, ErrStat, ErrMsg ) + TYPE(NacData), INTENT(IN) :: SrcNacDataData + TYPE(NacData), INTENT(INOUT) :: DstNacDataData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_CopyNacData' +! + ErrStat = ErrID_None + ErrMsg = "" + DstNacDataData%origin_t = SrcNacDataData%origin_t + DstNacDataData%motionType = SrcNacDataData%motionType + DstNacDataData%iMotion = SrcNacDataData%iMotion + DstNacDataData%yaw = SrcNacDataData%yaw + DstNacDataData%yawSpeed = SrcNacDataData%yawSpeed + DstNacDataData%yawAcc = SrcNacDataData%yawAcc + DstNacDataData%motionFileName = SrcNacDataData%motionFileName +IF (ALLOCATED(SrcNacDataData%motion)) THEN + i1_l = LBOUND(SrcNacDataData%motion,1) + i1_u = UBOUND(SrcNacDataData%motion,1) + i2_l = LBOUND(SrcNacDataData%motion,2) + i2_u = UBOUND(SrcNacDataData%motion,2) + IF (.NOT. ALLOCATED(DstNacDataData%motion)) THEN + ALLOCATE(DstNacDataData%motion(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstNacDataData%motion.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstNacDataData%motion = SrcNacDataData%motion +ENDIF + END SUBROUTINE AD_Dvr_CopyNacData + + SUBROUTINE AD_Dvr_DestroyNacData( NacDataData, ErrStat, ErrMsg, DEALLOCATEpointers ) + TYPE(NacData), INTENT(INOUT) :: NacDataData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + LOGICAL :: DEALLOCATEpointers_local + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_DestroyNacData' + + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + +IF (ALLOCATED(NacDataData%motion)) THEN + DEALLOCATE(NacDataData%motion) +ENDIF + END SUBROUTINE AD_Dvr_DestroyNacData + + SUBROUTINE AD_Dvr_PackNacData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(NacData), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_PackNacData' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Re_BufSz = Re_BufSz + SIZE(InData%origin_t) ! origin_t + Int_BufSz = Int_BufSz + 1 ! motionType + Int_BufSz = Int_BufSz + 1 ! iMotion + Re_BufSz = Re_BufSz + 1 ! yaw + Re_BufSz = Re_BufSz + 1 ! yawSpeed + Re_BufSz = Re_BufSz + 1 ! yawAcc + Int_BufSz = Int_BufSz + 1*LEN(InData%motionFileName) ! motionFileName + Int_BufSz = Int_BufSz + 1 ! motion allocated yes/no + IF ( ALLOCATED(InData%motion) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! motion upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%motion) ! motion + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + DO i1 = LBOUND(InData%origin_t,1), UBOUND(InData%origin_t,1) + ReKiBuf(Re_Xferred) = InData%origin_t(i1) + Re_Xferred = Re_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%motionType + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%iMotion + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%yaw + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%yawSpeed + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%yawAcc + Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(InData%motionFileName) + IntKiBuf(Int_Xferred) = ICHAR(InData%motionFileName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IF ( .NOT. ALLOCATED(InData%motion) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%motion,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%motion,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%motion,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%motion,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%motion,2), UBOUND(InData%motion,2) + DO i1 = LBOUND(InData%motion,1), UBOUND(InData%motion,1) + ReKiBuf(Re_Xferred) = InData%motion(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + END SUBROUTINE AD_Dvr_PackNacData + + SUBROUTINE AD_Dvr_UnPackNacData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(NacData), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_UnPackNacData' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + i1_l = LBOUND(OutData%origin_t,1) + i1_u = UBOUND(OutData%origin_t,1) + DO i1 = LBOUND(OutData%origin_t,1), UBOUND(OutData%origin_t,1) + OutData%origin_t(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%motionType = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%iMotion = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%yaw = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%yawSpeed = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%yawAcc = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(OutData%motionFileName) + OutData%motionFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! motion not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%motion)) DEALLOCATE(OutData%motion) + ALLOCATE(OutData%motion(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%motion.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%motion,2), UBOUND(OutData%motion,2) + DO i1 = LBOUND(OutData%motion,1), UBOUND(OutData%motion,1) + OutData%motion(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + END SUBROUTINE AD_Dvr_UnPackNacData + + SUBROUTINE AD_Dvr_CopyTwrData( SrcTwrDataData, DstTwrDataData, CtrlCode, ErrStat, ErrMsg ) + TYPE(TwrData), INTENT(IN) :: SrcTwrDataData + TYPE(TwrData), INTENT(INOUT) :: DstTwrDataData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_CopyTwrData' +! + ErrStat = ErrID_None + ErrMsg = "" + DstTwrDataData%origin_t = SrcTwrDataData%origin_t + END SUBROUTINE AD_Dvr_CopyTwrData + + SUBROUTINE AD_Dvr_DestroyTwrData( TwrDataData, ErrStat, ErrMsg, DEALLOCATEpointers ) + TYPE(TwrData), INTENT(INOUT) :: TwrDataData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + LOGICAL :: DEALLOCATEpointers_local + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_DestroyTwrData' + + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + + END SUBROUTINE AD_Dvr_DestroyTwrData + + SUBROUTINE AD_Dvr_PackTwrData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(TwrData), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_PackTwrData' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Re_BufSz = Re_BufSz + SIZE(InData%origin_t) ! origin_t + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + DO i1 = LBOUND(InData%origin_t,1), UBOUND(InData%origin_t,1) + ReKiBuf(Re_Xferred) = InData%origin_t(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END SUBROUTINE AD_Dvr_PackTwrData + + SUBROUTINE AD_Dvr_UnPackTwrData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(TwrData), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_UnPackTwrData' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + i1_l = LBOUND(OutData%origin_t,1) + i1_u = UBOUND(OutData%origin_t,1) + DO i1 = LBOUND(OutData%origin_t,1), UBOUND(OutData%origin_t,1) + OutData%origin_t(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END SUBROUTINE AD_Dvr_UnPackTwrData + + SUBROUTINE AD_Dvr_CopyWTData( SrcWTDataData, DstWTDataData, CtrlCode, ErrStat, ErrMsg ) + TYPE(WTData), INTENT(INOUT) :: SrcWTDataData + TYPE(WTData), INTENT(INOUT) :: DstWTDataData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_CopyWTData' +! + ErrStat = ErrID_None + ErrMsg = "" + DstWTDataData%originInit = SrcWTDataData%originInit + DstWTDataData%orientationInit = SrcWTDataData%orientationInit + CALL NWTC_Library_Copymeshmaptype( SrcWTDataData%map2twrPt, DstWTDataData%map2twrPt, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL NWTC_Library_Copymeshmaptype( SrcWTDataData%map2nacPt, DstWTDataData%map2nacPt, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL NWTC_Library_Copymeshmaptype( SrcWTDataData%map2hubPt, DstWTDataData%map2hubPt, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcWTDataData%map2BldPt)) THEN + i1_l = LBOUND(SrcWTDataData%map2BldPt,1) + i1_u = UBOUND(SrcWTDataData%map2BldPt,1) + IF (.NOT. ALLOCATED(DstWTDataData%map2BldPt)) THEN + ALLOCATE(DstWTDataData%map2BldPt(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWTDataData%map2BldPt.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcWTDataData%map2BldPt,1), UBOUND(SrcWTDataData%map2BldPt,1) + CALL NWTC_Library_Copymeshmaptype( SrcWTDataData%map2BldPt(i1), DstWTDataData%map2BldPt(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcWTDataData%bld)) THEN + i1_l = LBOUND(SrcWTDataData%bld,1) + i1_u = UBOUND(SrcWTDataData%bld,1) + IF (.NOT. ALLOCATED(DstWTDataData%bld)) THEN + ALLOCATE(DstWTDataData%bld(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWTDataData%bld.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcWTDataData%bld,1), UBOUND(SrcWTDataData%bld,1) + CALL AD_Dvr_Copybladedata( SrcWTDataData%bld(i1), DstWTDataData%bld(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF + CALL AD_Dvr_Copyhubdata( SrcWTDataData%hub, DstWTDataData%hub, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL AD_Dvr_Copynacdata( SrcWTDataData%nac, DstWTDataData%nac, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL AD_Dvr_Copytwrdata( SrcWTDataData%twr, DstWTDataData%twr, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + DstWTDataData%numBlades = SrcWTDataData%numBlades + DstWTDataData%basicHAWTFormat = SrcWTDataData%basicHAWTFormat + DstWTDataData%hasTower = SrcWTDataData%hasTower + DstWTDataData%projMod = SrcWTDataData%projMod + DstWTDataData%HAWTprojection = SrcWTDataData%HAWTprojection + DstWTDataData%motionType = SrcWTDataData%motionType +IF (ALLOCATED(SrcWTDataData%motion)) THEN + i1_l = LBOUND(SrcWTDataData%motion,1) + i1_u = UBOUND(SrcWTDataData%motion,1) + i2_l = LBOUND(SrcWTDataData%motion,2) + i2_u = UBOUND(SrcWTDataData%motion,2) + IF (.NOT. ALLOCATED(DstWTDataData%motion)) THEN + ALLOCATE(DstWTDataData%motion(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWTDataData%motion.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstWTDataData%motion = SrcWTDataData%motion +ENDIF + DstWTDataData%iMotion = SrcWTDataData%iMotion + DstWTDataData%degreeOfFreedom = SrcWTDataData%degreeOfFreedom + DstWTDataData%amplitude = SrcWTDataData%amplitude + DstWTDataData%frequency = SrcWTDataData%frequency + DstWTDataData%motionFileName = SrcWTDataData%motionFileName +IF (ALLOCATED(SrcWTDataData%WriteOutput)) THEN + i1_l = LBOUND(SrcWTDataData%WriteOutput,1) + i1_u = UBOUND(SrcWTDataData%WriteOutput,1) + IF (.NOT. ALLOCATED(DstWTDataData%WriteOutput)) THEN + ALLOCATE(DstWTDataData%WriteOutput(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWTDataData%WriteOutput.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstWTDataData%WriteOutput = SrcWTDataData%WriteOutput +ENDIF +IF (ALLOCATED(SrcWTDataData%userSwapArray)) THEN + i1_l = LBOUND(SrcWTDataData%userSwapArray,1) + i1_u = UBOUND(SrcWTDataData%userSwapArray,1) + IF (.NOT. ALLOCATED(DstWTDataData%userSwapArray)) THEN + ALLOCATE(DstWTDataData%userSwapArray(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWTDataData%userSwapArray.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstWTDataData%userSwapArray = SrcWTDataData%userSwapArray +ENDIF + END SUBROUTINE AD_Dvr_CopyWTData + + SUBROUTINE AD_Dvr_DestroyWTData( WTDataData, ErrStat, ErrMsg, DEALLOCATEpointers ) + TYPE(WTData), INTENT(INOUT) :: WTDataData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + LOGICAL :: DEALLOCATEpointers_local + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_DestroyWTData' + + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + + CALL NWTC_Library_Destroymeshmaptype( WTDataData%map2twrPt, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL NWTC_Library_Destroymeshmaptype( WTDataData%map2nacPt, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL NWTC_Library_Destroymeshmaptype( WTDataData%map2hubPt, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +IF (ALLOCATED(WTDataData%map2BldPt)) THEN +DO i1 = LBOUND(WTDataData%map2BldPt,1), UBOUND(WTDataData%map2BldPt,1) + CALL NWTC_Library_Destroymeshmaptype( WTDataData%map2BldPt(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(WTDataData%map2BldPt) +ENDIF +IF (ALLOCATED(WTDataData%bld)) THEN +DO i1 = LBOUND(WTDataData%bld,1), UBOUND(WTDataData%bld,1) + CALL AD_Dvr_Destroybladedata( WTDataData%bld(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(WTDataData%bld) +ENDIF + CALL AD_Dvr_Destroyhubdata( WTDataData%hub, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL AD_Dvr_Destroynacdata( WTDataData%nac, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL AD_Dvr_Destroytwrdata( WTDataData%twr, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +IF (ALLOCATED(WTDataData%motion)) THEN + DEALLOCATE(WTDataData%motion) +ENDIF +IF (ALLOCATED(WTDataData%WriteOutput)) THEN + DEALLOCATE(WTDataData%WriteOutput) +ENDIF +IF (ALLOCATED(WTDataData%userSwapArray)) THEN + DEALLOCATE(WTDataData%userSwapArray) +ENDIF + END SUBROUTINE AD_Dvr_DestroyWTData + + SUBROUTINE AD_Dvr_PackWTData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(WTData), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_PackWTData' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Re_BufSz = Re_BufSz + SIZE(InData%originInit) ! originInit + Re_BufSz = Re_BufSz + SIZE(InData%orientationInit) ! orientationInit + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + Int_BufSz = Int_BufSz + 3 ! map2twrPt: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%map2twrPt, ErrStat2, ErrMsg2, .TRUE. ) ! map2twrPt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! map2twrPt + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! map2twrPt + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! map2twrPt + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! map2nacPt: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%map2nacPt, ErrStat2, ErrMsg2, .TRUE. ) ! map2nacPt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! map2nacPt + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! map2nacPt + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! map2nacPt + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! map2hubPt: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%map2hubPt, ErrStat2, ErrMsg2, .TRUE. ) ! map2hubPt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! map2hubPt + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! map2hubPt + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! map2hubPt + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 1 ! map2BldPt allocated yes/no + IF ( ALLOCATED(InData%map2BldPt) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! map2BldPt upper/lower bounds for each dimension + DO i1 = LBOUND(InData%map2BldPt,1), UBOUND(InData%map2BldPt,1) + Int_BufSz = Int_BufSz + 3 ! map2BldPt: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%map2BldPt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! map2BldPt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! map2BldPt + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! map2BldPt + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! map2BldPt + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! bld allocated yes/no + IF ( ALLOCATED(InData%bld) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! bld upper/lower bounds for each dimension + DO i1 = LBOUND(InData%bld,1), UBOUND(InData%bld,1) + Int_BufSz = Int_BufSz + 3 ! bld: size of buffers for each call to pack subtype + CALL AD_Dvr_Packbladedata( Re_Buf, Db_Buf, Int_Buf, InData%bld(i1), ErrStat2, ErrMsg2, .TRUE. ) ! bld + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! bld + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! bld + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! bld + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 3 ! hub: size of buffers for each call to pack subtype + CALL AD_Dvr_Packhubdata( Re_Buf, Db_Buf, Int_Buf, InData%hub, ErrStat2, ErrMsg2, .TRUE. ) ! hub + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! hub + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! hub + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! hub + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! nac: size of buffers for each call to pack subtype + CALL AD_Dvr_Packnacdata( Re_Buf, Db_Buf, Int_Buf, InData%nac, ErrStat2, ErrMsg2, .TRUE. ) ! nac + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! nac + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! nac + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! nac + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! twr: size of buffers for each call to pack subtype + CALL AD_Dvr_Packtwrdata( Re_Buf, Db_Buf, Int_Buf, InData%twr, ErrStat2, ErrMsg2, .TRUE. ) ! twr + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! twr + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! twr + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! twr + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 1 ! numBlades + Int_BufSz = Int_BufSz + 1 ! basicHAWTFormat + Int_BufSz = Int_BufSz + 1 ! hasTower + Int_BufSz = Int_BufSz + 1 ! projMod + Int_BufSz = Int_BufSz + 1 ! HAWTprojection + Int_BufSz = Int_BufSz + 1 ! motionType + Int_BufSz = Int_BufSz + 1 ! motion allocated yes/no + IF ( ALLOCATED(InData%motion) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! motion upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%motion) ! motion + END IF + Int_BufSz = Int_BufSz + 1 ! iMotion + Int_BufSz = Int_BufSz + 1 ! degreeOfFreedom + Re_BufSz = Re_BufSz + 1 ! amplitude + Re_BufSz = Re_BufSz + 1 ! frequency + Int_BufSz = Int_BufSz + 1*LEN(InData%motionFileName) ! motionFileName + Int_BufSz = Int_BufSz + 1 ! WriteOutput allocated yes/no + IF ( ALLOCATED(InData%WriteOutput) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! WriteOutput upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WriteOutput) ! WriteOutput + END IF + Int_BufSz = Int_BufSz + 1 ! userSwapArray allocated yes/no + IF ( ALLOCATED(InData%userSwapArray) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! userSwapArray upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%userSwapArray) ! userSwapArray + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + DO i1 = LBOUND(InData%originInit,1), UBOUND(InData%originInit,1) + ReKiBuf(Re_Xferred) = InData%originInit(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%orientationInit,1), UBOUND(InData%orientationInit,1) + ReKiBuf(Re_Xferred) = InData%orientationInit(i1) + Re_Xferred = Re_Xferred + 1 + END DO + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%map2twrPt, ErrStat2, ErrMsg2, OnlySize ) ! map2twrPt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%map2nacPt, ErrStat2, ErrMsg2, OnlySize ) ! map2nacPt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%map2hubPt, ErrStat2, ErrMsg2, OnlySize ) ! map2hubPt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF ( .NOT. ALLOCATED(InData%map2BldPt) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%map2BldPt,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%map2BldPt,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%map2BldPt,1), UBOUND(InData%map2BldPt,1) + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%map2BldPt(i1), ErrStat2, ErrMsg2, OnlySize ) ! map2BldPt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%bld) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%bld,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%bld,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%bld,1), UBOUND(InData%bld,1) + CALL AD_Dvr_Packbladedata( Re_Buf, Db_Buf, Int_Buf, InData%bld(i1), ErrStat2, ErrMsg2, OnlySize ) ! bld + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + CALL AD_Dvr_Packhubdata( Re_Buf, Db_Buf, Int_Buf, InData%hub, ErrStat2, ErrMsg2, OnlySize ) ! hub + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL AD_Dvr_Packnacdata( Re_Buf, Db_Buf, Int_Buf, InData%nac, ErrStat2, ErrMsg2, OnlySize ) ! nac + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL AD_Dvr_Packtwrdata( Re_Buf, Db_Buf, Int_Buf, InData%twr, ErrStat2, ErrMsg2, OnlySize ) ! twr + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IntKiBuf(Int_Xferred) = InData%numBlades + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%basicHAWTFormat, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%hasTower, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%projMod + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%HAWTprojection, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%motionType + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%motion) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%motion,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%motion,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%motion,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%motion,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%motion,2), UBOUND(InData%motion,2) + DO i1 = LBOUND(InData%motion,1), UBOUND(InData%motion,1) + ReKiBuf(Re_Xferred) = InData%motion(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IntKiBuf(Int_Xferred) = InData%iMotion + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%degreeOfFreedom + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%amplitude + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%frequency + Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(InData%motionFileName) + IntKiBuf(Int_Xferred) = ICHAR(InData%motionFileName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IF ( .NOT. ALLOCATED(InData%WriteOutput) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutput,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) + ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%userSwapArray) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%userSwapArray,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%userSwapArray,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%userSwapArray,1), UBOUND(InData%userSwapArray,1) + ReKiBuf(Re_Xferred) = InData%userSwapArray(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + END SUBROUTINE AD_Dvr_PackWTData + + SUBROUTINE AD_Dvr_UnPackWTData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(WTData), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_UnPackWTData' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + i1_l = LBOUND(OutData%originInit,1) + i1_u = UBOUND(OutData%originInit,1) + DO i1 = LBOUND(OutData%originInit,1), UBOUND(OutData%originInit,1) + OutData%originInit(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + i1_l = LBOUND(OutData%orientationInit,1) + i1_u = UBOUND(OutData%orientationInit,1) + DO i1 = LBOUND(OutData%orientationInit,1), UBOUND(OutData%orientationInit,1) + OutData%orientationInit(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%map2twrPt, ErrStat2, ErrMsg2 ) ! map2twrPt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%map2nacPt, ErrStat2, ErrMsg2 ) ! map2nacPt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%map2hubPt, ErrStat2, ErrMsg2 ) ! map2hubPt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! map2BldPt not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%map2BldPt)) DEALLOCATE(OutData%map2BldPt) + ALLOCATE(OutData%map2BldPt(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%map2BldPt.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%map2BldPt,1), UBOUND(OutData%map2BldPt,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%map2BldPt(i1), ErrStat2, ErrMsg2 ) ! map2BldPt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! bld not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%bld)) DEALLOCATE(OutData%bld) + ALLOCATE(OutData%bld(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%bld.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%bld,1), UBOUND(OutData%bld,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL AD_Dvr_Unpackbladedata( Re_Buf, Db_Buf, Int_Buf, OutData%bld(i1), ErrStat2, ErrMsg2 ) ! bld + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL AD_Dvr_Unpackhubdata( Re_Buf, Db_Buf, Int_Buf, OutData%hub, ErrStat2, ErrMsg2 ) ! hub + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL AD_Dvr_Unpacknacdata( Re_Buf, Db_Buf, Int_Buf, OutData%nac, ErrStat2, ErrMsg2 ) ! nac + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL AD_Dvr_Unpacktwrdata( Re_Buf, Db_Buf, Int_Buf, OutData%twr, ErrStat2, ErrMsg2 ) ! twr + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + OutData%numBlades = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%basicHAWTFormat = TRANSFER(IntKiBuf(Int_Xferred), OutData%basicHAWTFormat) + Int_Xferred = Int_Xferred + 1 + OutData%hasTower = TRANSFER(IntKiBuf(Int_Xferred), OutData%hasTower) + Int_Xferred = Int_Xferred + 1 + OutData%projMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%HAWTprojection = TRANSFER(IntKiBuf(Int_Xferred), OutData%HAWTprojection) + Int_Xferred = Int_Xferred + 1 + OutData%motionType = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! motion not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%motion)) DEALLOCATE(OutData%motion) + ALLOCATE(OutData%motion(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%motion.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%motion,2), UBOUND(OutData%motion,2) + DO i1 = LBOUND(OutData%motion,1), UBOUND(OutData%motion,1) + OutData%motion(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + OutData%iMotion = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%degreeOfFreedom = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%amplitude = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%frequency = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(OutData%motionFileName) + OutData%motionFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutput not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WriteOutput)) DEALLOCATE(OutData%WriteOutput) + ALLOCATE(OutData%WriteOutput(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) + OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! userSwapArray not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%userSwapArray)) DEALLOCATE(OutData%userSwapArray) + ALLOCATE(OutData%userSwapArray(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%userSwapArray.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%userSwapArray,1), UBOUND(OutData%userSwapArray,1) + OutData%userSwapArray(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + END SUBROUTINE AD_Dvr_UnPackWTData + + SUBROUTINE AD_Dvr_CopyDvr_SimData( SrcDvr_SimDataData, DstDvr_SimDataData, CtrlCode, ErrStat, ErrMsg ) + TYPE(Dvr_SimData), INTENT(INOUT) :: SrcDvr_SimDataData + TYPE(Dvr_SimData), INTENT(INOUT) :: DstDvr_SimDataData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_CopyDvr_SimData' +! + ErrStat = ErrID_None + ErrMsg = "" + DstDvr_SimDataData%AD_InputFile = SrcDvr_SimDataData%AD_InputFile + DstDvr_SimDataData%MHK = SrcDvr_SimDataData%MHK + DstDvr_SimDataData%AnalysisType = SrcDvr_SimDataData%AnalysisType + DstDvr_SimDataData%FldDens = SrcDvr_SimDataData%FldDens + DstDvr_SimDataData%KinVisc = SrcDvr_SimDataData%KinVisc + DstDvr_SimDataData%SpdSound = SrcDvr_SimDataData%SpdSound + DstDvr_SimDataData%Patm = SrcDvr_SimDataData%Patm + DstDvr_SimDataData%Pvap = SrcDvr_SimDataData%Pvap + DstDvr_SimDataData%WtrDpth = SrcDvr_SimDataData%WtrDpth + DstDvr_SimDataData%MSL2SWL = SrcDvr_SimDataData%MSL2SWL + DstDvr_SimDataData%numTurbines = SrcDvr_SimDataData%numTurbines +IF (ALLOCATED(SrcDvr_SimDataData%WT)) THEN + i1_l = LBOUND(SrcDvr_SimDataData%WT,1) + i1_u = UBOUND(SrcDvr_SimDataData%WT,1) + IF (.NOT. ALLOCATED(DstDvr_SimDataData%WT)) THEN + ALLOCATE(DstDvr_SimDataData%WT(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDvr_SimDataData%WT.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcDvr_SimDataData%WT,1), UBOUND(SrcDvr_SimDataData%WT,1) + CALL AD_Dvr_Copywtdata( SrcDvr_SimDataData%WT(i1), DstDvr_SimDataData%WT(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF + DstDvr_SimDataData%dT = SrcDvr_SimDataData%dT + DstDvr_SimDataData%tMax = SrcDvr_SimDataData%tMax + DstDvr_SimDataData%numSteps = SrcDvr_SimDataData%numSteps + DstDvr_SimDataData%numCases = SrcDvr_SimDataData%numCases +IF (ALLOCATED(SrcDvr_SimDataData%Cases)) THEN + i1_l = LBOUND(SrcDvr_SimDataData%Cases,1) + i1_u = UBOUND(SrcDvr_SimDataData%Cases,1) + IF (.NOT. ALLOCATED(DstDvr_SimDataData%Cases)) THEN + ALLOCATE(DstDvr_SimDataData%Cases(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDvr_SimDataData%Cases.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcDvr_SimDataData%Cases,1), UBOUND(SrcDvr_SimDataData%Cases,1) + CALL AD_Dvr_Copydvr_case( SrcDvr_SimDataData%Cases(i1), DstDvr_SimDataData%Cases(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF + DstDvr_SimDataData%iCase = SrcDvr_SimDataData%iCase +IF (ALLOCATED(SrcDvr_SimDataData%timeSeries)) THEN + i1_l = LBOUND(SrcDvr_SimDataData%timeSeries,1) + i1_u = UBOUND(SrcDvr_SimDataData%timeSeries,1) + i2_l = LBOUND(SrcDvr_SimDataData%timeSeries,2) + i2_u = UBOUND(SrcDvr_SimDataData%timeSeries,2) + IF (.NOT. ALLOCATED(DstDvr_SimDataData%timeSeries)) THEN + ALLOCATE(DstDvr_SimDataData%timeSeries(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDvr_SimDataData%timeSeries.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstDvr_SimDataData%timeSeries = SrcDvr_SimDataData%timeSeries +ENDIF + DstDvr_SimDataData%iTimeSeries = SrcDvr_SimDataData%iTimeSeries + DstDvr_SimDataData%root = SrcDvr_SimDataData%root + CALL AD_Dvr_Copydvr_outputs( SrcDvr_SimDataData%out, DstDvr_SimDataData%out, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL ADI_Copyiw_inputdata( SrcDvr_SimDataData%IW_InitInp, DstDvr_SimDataData%IW_InitInp, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + END SUBROUTINE AD_Dvr_CopyDvr_SimData + + SUBROUTINE AD_Dvr_DestroyDvr_SimData( Dvr_SimDataData, ErrStat, ErrMsg, DEALLOCATEpointers ) + TYPE(Dvr_SimData), INTENT(INOUT) :: Dvr_SimDataData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + LOGICAL :: DEALLOCATEpointers_local + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_DestroyDvr_SimData' + + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + +IF (ALLOCATED(Dvr_SimDataData%WT)) THEN +DO i1 = LBOUND(Dvr_SimDataData%WT,1), UBOUND(Dvr_SimDataData%WT,1) + CALL AD_Dvr_Destroywtdata( Dvr_SimDataData%WT(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(Dvr_SimDataData%WT) +ENDIF +IF (ALLOCATED(Dvr_SimDataData%Cases)) THEN +DO i1 = LBOUND(Dvr_SimDataData%Cases,1), UBOUND(Dvr_SimDataData%Cases,1) + CALL AD_Dvr_Destroydvr_case( Dvr_SimDataData%Cases(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(Dvr_SimDataData%Cases) +ENDIF +IF (ALLOCATED(Dvr_SimDataData%timeSeries)) THEN + DEALLOCATE(Dvr_SimDataData%timeSeries) +ENDIF + CALL AD_Dvr_Destroydvr_outputs( Dvr_SimDataData%out, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL ADI_Destroyiw_inputdata( Dvr_SimDataData%IW_InitInp, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + END SUBROUTINE AD_Dvr_DestroyDvr_SimData + + SUBROUTINE AD_Dvr_PackDvr_SimData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(Dvr_SimData), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_PackDvr_SimData' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1*LEN(InData%AD_InputFile) ! AD_InputFile + Int_BufSz = Int_BufSz + 1 ! MHK + Int_BufSz = Int_BufSz + 1 ! AnalysisType + Re_BufSz = Re_BufSz + 1 ! FldDens + Re_BufSz = Re_BufSz + 1 ! KinVisc + Re_BufSz = Re_BufSz + 1 ! SpdSound + Re_BufSz = Re_BufSz + 1 ! Patm + Re_BufSz = Re_BufSz + 1 ! Pvap + Re_BufSz = Re_BufSz + 1 ! WtrDpth + Re_BufSz = Re_BufSz + 1 ! MSL2SWL + Int_BufSz = Int_BufSz + 1 ! numTurbines + Int_BufSz = Int_BufSz + 1 ! WT allocated yes/no + IF ( ALLOCATED(InData%WT) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! WT upper/lower bounds for each dimension + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + DO i1 = LBOUND(InData%WT,1), UBOUND(InData%WT,1) + Int_BufSz = Int_BufSz + 3 ! WT: size of buffers for each call to pack subtype + CALL AD_Dvr_Packwtdata( Re_Buf, Db_Buf, Int_Buf, InData%WT(i1), ErrStat2, ErrMsg2, .TRUE. ) ! WT + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! WT + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! WT + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! WT + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Db_BufSz = Db_BufSz + 1 ! dT + Db_BufSz = Db_BufSz + 1 ! tMax + Int_BufSz = Int_BufSz + 1 ! numSteps + Int_BufSz = Int_BufSz + 1 ! numCases + Int_BufSz = Int_BufSz + 1 ! Cases allocated yes/no + IF ( ALLOCATED(InData%Cases) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Cases upper/lower bounds for each dimension + DO i1 = LBOUND(InData%Cases,1), UBOUND(InData%Cases,1) + Int_BufSz = Int_BufSz + 3 ! Cases: size of buffers for each call to pack subtype + CALL AD_Dvr_Packdvr_case( Re_Buf, Db_Buf, Int_Buf, InData%Cases(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Cases + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Cases + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Cases + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Cases + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! iCase + Int_BufSz = Int_BufSz + 1 ! timeSeries allocated yes/no + IF ( ALLOCATED(InData%timeSeries) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! timeSeries upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%timeSeries) ! timeSeries + END IF + Int_BufSz = Int_BufSz + 1 ! iTimeSeries + Int_BufSz = Int_BufSz + 1*LEN(InData%root) ! root + Int_BufSz = Int_BufSz + 3 ! out: size of buffers for each call to pack subtype + CALL AD_Dvr_Packdvr_outputs( Re_Buf, Db_Buf, Int_Buf, InData%out, ErrStat2, ErrMsg2, .TRUE. ) ! out + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! out + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! out + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! out + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! IW_InitInp: size of buffers for each call to pack subtype + CALL ADI_Packiw_inputdata( Re_Buf, Db_Buf, Int_Buf, InData%IW_InitInp, ErrStat2, ErrMsg2, .TRUE. ) ! IW_InitInp + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! IW_InitInp + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! IW_InitInp + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! IW_InitInp + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + DO I = 1, LEN(InData%AD_InputFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%AD_InputFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%MHK + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%AnalysisType + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%FldDens + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%KinVisc + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SpdSound + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Patm + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Pvap + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WtrDpth + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MSL2SWL + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%numTurbines + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%WT) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WT,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WT,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%WT,1), UBOUND(InData%WT,1) + CALL AD_Dvr_Packwtdata( Re_Buf, Db_Buf, Int_Buf, InData%WT(i1), ErrStat2, ErrMsg2, OnlySize ) ! WT + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + DbKiBuf(Db_Xferred) = InData%dT + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%tMax + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%numSteps + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%numCases + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%Cases) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Cases,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cases,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%Cases,1), UBOUND(InData%Cases,1) + CALL AD_Dvr_Packdvr_case( Re_Buf, Db_Buf, Int_Buf, InData%Cases(i1), ErrStat2, ErrMsg2, OnlySize ) ! Cases + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IntKiBuf(Int_Xferred) = InData%iCase + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%timeSeries) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%timeSeries,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%timeSeries,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%timeSeries,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%timeSeries,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%timeSeries,2), UBOUND(InData%timeSeries,2) + DO i1 = LBOUND(InData%timeSeries,1), UBOUND(InData%timeSeries,1) + ReKiBuf(Re_Xferred) = InData%timeSeries(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IntKiBuf(Int_Xferred) = InData%iTimeSeries + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%root) + IntKiBuf(Int_Xferred) = ICHAR(InData%root(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + CALL AD_Dvr_Packdvr_outputs( Re_Buf, Db_Buf, Int_Buf, InData%out, ErrStat2, ErrMsg2, OnlySize ) ! out + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL ADI_Packiw_inputdata( Re_Buf, Db_Buf, Int_Buf, InData%IW_InitInp, ErrStat2, ErrMsg2, OnlySize ) ! IW_InitInp + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END SUBROUTINE AD_Dvr_PackDvr_SimData + + SUBROUTINE AD_Dvr_UnPackDvr_SimData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(Dvr_SimData), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_UnPackDvr_SimData' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + DO I = 1, LEN(OutData%AD_InputFile) + OutData%AD_InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%MHK = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%AnalysisType = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%FldDens = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%KinVisc = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SpdSound = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Patm = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Pvap = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WtrDpth = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MSL2SWL = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%numTurbines = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WT not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WT)) DEALLOCATE(OutData%WT) + ALLOCATE(OutData%WT(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WT.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%WT,1), UBOUND(OutData%WT,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL AD_Dvr_Unpackwtdata( Re_Buf, Db_Buf, Int_Buf, OutData%WT(i1), ErrStat2, ErrMsg2 ) ! WT + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + OutData%dT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%tMax = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%numSteps = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%numCases = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cases not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Cases)) DEALLOCATE(OutData%Cases) + ALLOCATE(OutData%Cases(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cases.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%Cases,1), UBOUND(OutData%Cases,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL AD_Dvr_Unpackdvr_case( Re_Buf, Db_Buf, Int_Buf, OutData%Cases(i1), ErrStat2, ErrMsg2 ) ! Cases + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + OutData%iCase = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! timeSeries not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%timeSeries)) DEALLOCATE(OutData%timeSeries) + ALLOCATE(OutData%timeSeries(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%timeSeries.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%timeSeries,2), UBOUND(OutData%timeSeries,2) + DO i1 = LBOUND(OutData%timeSeries,1), UBOUND(OutData%timeSeries,1) + OutData%timeSeries(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + OutData%iTimeSeries = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%root) + OutData%root(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL AD_Dvr_Unpackdvr_outputs( Re_Buf, Db_Buf, Int_Buf, OutData%out, ErrStat2, ErrMsg2 ) ! out + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL ADI_Unpackiw_inputdata( Re_Buf, Db_Buf, Int_Buf, OutData%IW_InitInp, ErrStat2, ErrMsg2 ) ! IW_InitInp + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END SUBROUTINE AD_Dvr_UnPackDvr_SimData + + SUBROUTINE AD_Dvr_CopyAllData( SrcAllDataData, DstAllDataData, CtrlCode, ErrStat, ErrMsg ) + TYPE(AllData), INTENT(INOUT) :: SrcAllDataData + TYPE(AllData), INTENT(INOUT) :: DstAllDataData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_CopyAllData' +! + ErrStat = ErrID_None + ErrMsg = "" + CALL AD_Dvr_Copydvr_simdata( SrcAllDataData%dvr, DstAllDataData%dvr, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL ADI_Copydata( SrcAllDataData%ADI, DstAllDataData%ADI, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL ADI_Copyfed_data( SrcAllDataData%FED, DstAllDataData%FED, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + DstAllDataData%errStat = SrcAllDataData%errStat + DstAllDataData%errMsg = SrcAllDataData%errMsg + DstAllDataData%initialized = SrcAllDataData%initialized + END SUBROUTINE AD_Dvr_CopyAllData + + SUBROUTINE AD_Dvr_DestroyAllData( AllDataData, ErrStat, ErrMsg, DEALLOCATEpointers ) + TYPE(AllData), INTENT(INOUT) :: AllDataData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + LOGICAL :: DEALLOCATEpointers_local + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_DestroyAllData' + + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + + CALL AD_Dvr_Destroydvr_simdata( AllDataData%dvr, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL ADI_Destroydata( AllDataData%ADI, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL ADI_Destroyfed_data( AllDataData%FED, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + END SUBROUTINE AD_Dvr_DestroyAllData + + SUBROUTINE AD_Dvr_PackAllData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(AllData), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_PackAllData' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + Int_BufSz = Int_BufSz + 3 ! dvr: size of buffers for each call to pack subtype + CALL AD_Dvr_Packdvr_simdata( Re_Buf, Db_Buf, Int_Buf, InData%dvr, ErrStat2, ErrMsg2, .TRUE. ) ! dvr + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! dvr + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! dvr + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! dvr + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! ADI: size of buffers for each call to pack subtype + CALL ADI_Packdata( Re_Buf, Db_Buf, Int_Buf, InData%ADI, ErrStat2, ErrMsg2, .TRUE. ) ! ADI + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! ADI + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! ADI + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! ADI + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! FED: size of buffers for each call to pack subtype + CALL ADI_Packfed_data( Re_Buf, Db_Buf, Int_Buf, InData%FED, ErrStat2, ErrMsg2, .TRUE. ) ! FED + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! FED + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! FED + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! FED + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 1 ! errStat + Int_BufSz = Int_BufSz + 1*LEN(InData%errMsg) ! errMsg + Int_BufSz = Int_BufSz + 1 ! initialized + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + CALL AD_Dvr_Packdvr_simdata( Re_Buf, Db_Buf, Int_Buf, InData%dvr, ErrStat2, ErrMsg2, OnlySize ) ! dvr + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL ADI_Packdata( Re_Buf, Db_Buf, Int_Buf, InData%ADI, ErrStat2, ErrMsg2, OnlySize ) ! ADI + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL ADI_Packfed_data( Re_Buf, Db_Buf, Int_Buf, InData%FED, ErrStat2, ErrMsg2, OnlySize ) ! FED + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IntKiBuf(Int_Xferred) = InData%errStat + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%errMsg) + IntKiBuf(Int_Xferred) = ICHAR(InData%errMsg(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%initialized, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END SUBROUTINE AD_Dvr_PackAllData + + SUBROUTINE AD_Dvr_UnPackAllData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(AllData), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_UnPackAllData' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL AD_Dvr_Unpackdvr_simdata( Re_Buf, Db_Buf, Int_Buf, OutData%dvr, ErrStat2, ErrMsg2 ) ! dvr + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL ADI_Unpackdata( Re_Buf, Db_Buf, Int_Buf, OutData%ADI, ErrStat2, ErrMsg2 ) ! ADI + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL ADI_Unpackfed_data( Re_Buf, Db_Buf, Int_Buf, OutData%FED, ErrStat2, ErrMsg2 ) ! FED + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + OutData%errStat = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%errMsg) + OutData%errMsg(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%initialized = TRANSFER(IntKiBuf(Int_Xferred), OutData%initialized) + Int_Xferred = Int_Xferred + 1 + END SUBROUTINE AD_Dvr_UnPackAllData + +END MODULE AeroDyn_Driver_Types +!ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn/src/AeroDyn_IO.f90 b/modules/aerodyn/src/AeroDyn_IO.f90 index 535f99cb84..c5233a30cd 100644 --- a/modules/aerodyn/src/AeroDyn_IO.f90 +++ b/modules/aerodyn/src/AeroDyn_IO.f90 @@ -2203,7 +2203,7 @@ subroutine Calc_WriteOutput_AD() end do ! k=blades ! rotor outputs - if ( EqualRealNos( m%V_dot_x, 0.0_ReKi ) ) then + if ( EqualRealNos( real(m%V_dot_x,SiKi), 0.0_SiKi ) ) then m%AllOuts( RtTSR ) = 0.0_ReKi m%AllOuts( RtFldCp ) = 0.0_ReKi m%AllOuts( RtFldCq ) = 0.0_ReKi @@ -4265,6 +4265,260 @@ END SUBROUTINE SetOutParam !End of code generated by Matlab script !********************************************************************************************************************************** +!---------------------------------------------------------------------------------------------------------------------------------- +!> This subroutine sets up the information needed for plotting VTK surfaces. +subroutine AD_SetVTKSurface(InitOutData_AD, u_AD, VTK_Surface, errStat, errMsg) + type(AD_InitOutputType), intent(inout) :: InitOutData_AD !< The initialization output from AeroDyn + type(AD_InputType), target, intent(in ) :: u_AD + type(AD_VTK_RotSurfaceType), allocatable, intent(inout) :: VTK_Surface(:) ! VTK_Surface for each rotor + integer(IntKi), intent( out) :: errStat !< Error status of the operation + character(*), intent( out) :: errMsg !< Error message if errStat /= ErrID_None + real(SiKi) :: TwrDiam_top, TwrDiam_base, TwrRatio, TwrLength + integer(IntKi) :: topNode, baseNode, cylNode, tipNode, rootNode + integer(IntKi) :: k + character(1024) :: vtkroot + integer(IntKi) :: iWT + integer(IntKi) :: errStat2 + character(ErrMsgLen) :: errMsg2 + type(MeshType), pointer :: Mesh + integer(IntKi) :: nBlades + integer(IntKi) :: nWT + errStat = ErrID_None + errMsg = "" + + if (allocated(VTK_Surface)) then + return ! The surfaces were already computed (for combined cases) + endif + + nWT = size(u_AD%rotors) + allocate(VTK_Surface(nWT),stat=errStat2); errMsg2='Allocating VTK_Surface'; if(Failed()) return + + ! --- Create surfaces for Nacelle, Base, Tower, Blades + do iWT=1,nWT + !....................... + ! tapered tower + !....................... + Mesh=>u_AD%rotors(iWT)%TowerMotion + if(associated(Mesh)) then + if (Mesh%NNodes>0) then + CALL AllocAry(VTK_Surface(iWT)%TowerRad, Mesh%NNodes,'VTK_Surface(iWT)%TowerRad',errStat2,errMsg2) + topNode = Mesh%NNodes - 1 + !baseNode = Mesh%refNode + baseNode = 1 ! TODO TODO + TwrLength = TwoNorm( Mesh%position(:,topNode) - Mesh%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,Mesh%NNodes + TwrLength = TwoNorm( Mesh%position(:,k) - Mesh%position(:,baseNode) ) + VTK_Surface(iWT)%TowerRad(k) = 0.5*TwrDiam_Base + TwrRatio*TwrLength + end do + else + !print*,'>>>> TOWER HAS NO NODES' + ! TODO create a fake tower + CALL AllocAry(VTK_Surface(iWT)%TowerRad, 0,'VTK_Surface(iWT)%TowerRad',errStat2,errMsg2) + endif + endif + + !....................... + ! blade surfaces + !....................... + nBlades = size(u_AD%rotors(iWT)%BladeMotion) + allocate(VTK_Surface(iWT)%BladeShape(nBlades),stat=errStat2); errMsg2='Allocating BladeShape'; if(Failed()) return + if (allocated(InitOutData_AD%rotors(iWT)%BladeShape)) THEN + do k=1, nBlades + call move_alloc( InitOutData_AD%rotors(iWT)%BladeShape(k)%AirfoilCoords, VTK_Surface(iWT)%BladeShape(k)%AirfoilCoords ) + end do + else + call WrScr('Profile coordinates missing, using dummy coordinates for blade surface VTK outputs') + rootNode = 1 + do K=1, nBlades + tipNode = u_AD%rotors(iWT)%BladeMotion(K)%NNodes + cylNode = min(3,u_AD%rotors(iWT)%BladeMotion(K)%Nnodes) + call AD_SetVTKDefaultBladeParams(u_AD%rotors(iWT)%BladeMotion(K), VTK_Surface(iWT)%BladeShape(K), tipNode, rootNode, cylNode, errStat2, errMsg2, BlChord=InitOutData_AD%rotors(iWT)%BladeProps(k)%BlChord); if (Failed()) return + end do + endif + enddo ! iWT, turbines + +contains + + logical function Failed() + call SetErrStat(errStat2, errMsg2, errStat, errMsg, 'AD_SetVTKSurface') + Failed = errStat >= AbortErrLev + end function Failed + +end subroutine AD_SetVTKSurface +!---------------------------------------------------------------------------------------------------------------------------------- +!> Writes AeroDyn VTK surfaces (tower, hub, blades) +subroutine AD_WrVTK_Surfaces(u_AD, y_AD, RefPoint, VTK_Surface, VTK_count, OutFileRoot, tWidth, numSectors, HubRad) + type(AD_InputType), intent(in ) :: u_AD + type(AD_OutputType), intent(in ) :: y_AD + type(AD_VTK_RotSurfaceType), intent(in ) :: VTK_Surface(:) ! VTK_Surface for each rotor + real(SiKi), intent(in ) :: RefPoint(3) + real(SiKi), intent(in ) :: HubRad + integer(IntKi) , intent(in ) :: VTK_count + character(len=*), intent(in ) :: OutFileRoot + integer, intent(in ) :: tWidth + integer, intent(in ) :: numSectors + logical, parameter :: OutputFields = .FALSE. ! due to confusion about what fields mean on a surface, we are going to just output the basic meshes if people ask for fields + integer(IntKi) :: k + integer(IntKi) :: errStat2 + character(ErrMsgLen) :: errMSg2 + integer(IntKi) :: iWT + integer(IntKi) :: nBlades + integer(IntKi) :: nWT + character(10) :: sWT + + nWT = size(u_AD%rotors) + do iWT = 1, nWT + if (nWT==1) then + sWT = '' + else + sWT = '.T'//trim(num2lstr(iWT)) + endif + + ! Tower motions + if (u_AD%rotors(iWT)%TowerMotion%nNodes>0) then + call MeshWrVTK_Ln2Surface (RefPoint, u_AD%rotors(iWT)%TowerMotion, trim(OutFileRoot)//trim(sWT)//'.TowerSurface', & + VTK_count, OutputFields, errStat2, errMsg2, tWidth, numSectors, VTK_Surface(iWT)%TowerRad ) + endif + + nBlades = size(u_AD%rotors(iWT)%BladeMotion) + + if (nBlades>0) then + ! Hub + call MeshWrVTK_PointSurface (RefPoint, u_AD%rotors(iWT)%HubMotion, trim(OutFileRoot)//trim(sWT)//'.HubSurface', & + VTK_count, OutputFields, errStat2, errMsg2, tWidth , & + NumSegments=numSectors, radius=HubRad) + endif + + ! Blades + do K=1,nBlades + call MeshWrVTK_Ln2Surface (RefPoint, u_AD%rotors(iWT)%BladeMotion(K), trim(OutFileRoot)//trim(sWT)//'.Blade'//trim(num2lstr(k))//'Surface', & + VTK_count, OutputFields, errStat2, errMsg2, tWidth , verts=VTK_Surface(iWT)%BladeShape(K)%AirfoilCoords & + ,Sib=y_AD%rotors(iWT)%BladeLoad(k) ) + end do + enddo + +end subroutine AD_WrVTK_Surfaces +!---------------------------------------------------------------------------------------------------------------------------------- +!> Writes AeroDyn VTK Lines and points (tower, hub, blades) +subroutine AD_WrVTK_LinesPoints(u_AD, y_AD, RefPoint, VTK_count, OutFileRoot, tWidth) + type(AD_InputType), intent(in ) :: u_AD + type(AD_OutputType), intent(in ) :: y_AD + real(SiKi), intent(in ) :: RefPoint(3) + integer(IntKi), intent(in ) :: VTK_count + character(len=*), intent(in ) :: OutFileRoot + integer, intent(in ) :: tWidth + logical, parameter :: OutputFields = .TRUE. + integer(IntKi) :: k + integer(IntKi) :: errStat2 + character(ErrMsgLen) :: errMSg2 + integer(IntKi) :: iWT + integer(IntKi) :: nBlades + integer(IntKi) :: nWT + character(10) :: sWT + + nWT = size(u_AD%rotors) + do iWT = 1, nWT + if (nWT==1) then + sWT = '' + else + sWT = '.T'//trim(num2lstr(iWT)) + endif + + ! Tower motions + if (u_AD%rotors(iWT)%TowerMotion%nNodes>0) then + call MeshWrVTK(RefPoint, u_AD%rotors(iWT)%TowerMotion, trim(OutFileRoot)//trim(sWT)//'.Tower', & + VTK_count, OutputFields, errStat2, errMsg2, tWidth ) + endif + + nBlades = size(u_AD%rotors(iWT)%BladeMotion) + + if (nBlades>0) then + ! Hub + call MeshWrVTK(RefPoint, u_AD%rotors(iWT)%HubMotion, trim(OutFileRoot)//trim(sWT)//'.Hub', & + VTK_count, OutputFields, errStat2, errMsg2, tWidth ) + endif + + ! Blades + do K=1,nBlades + call MeshWrVTK(RefPoint, u_AD%rotors(iWT)%BladeMotion(K), trim(OutFileRoot)//trim(sWT)//'.Blade'//trim(num2lstr(k)), & + VTK_count, OutputFields, errStat2, errMsg2, tWidth, Sib=y_AD%rotors(iWT)%BladeLoad(k) ) + end do + enddo + +end subroutine AD_WrVTK_LinesPoints +!---------------------------------------------------------------------------------------------------------------------------------- +!> This subroutine comes up with some default airfoils for blade surfaces for a given blade mesh, M. +SUBROUTINE AD_SetVTKDefaultBladeParams(M, BladeShape, tipNode, rootNode, cylNode, errStat, errMsg, BlChord) + TYPE(MeshType), INTENT(IN ) :: M !< The Mesh the defaults should be calculated for + TYPE(AD_VTK_BLSurfaceType), INTENT(INOUT) :: BladeShape !< BladeShape to set to default values + INTEGER(IntKi), INTENT(IN ) :: rootNode !< Index of root node (innermost node) for this mesh + INTEGER(IntKi), INTENT(IN ) :: tipNode !< Index of tip node (outermost node) for this mesh + INTEGER(IntKi), INTENT(IN ) :: cylNode !< Index of last node to have a cylinder shape + INTEGER(IntKi), INTENT( OUT) :: errStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: errMsg !< Error message if errStat /= ErrID_None + REAL(ReKi), OPTIONAL, INTENT(IN ) :: BlChord(:) + REAL(SiKi) :: bladeLength, chord, pitchAxis + REAL(SiKi) :: bladeLengthFract, bladeLengthFract2, ratio, posLength ! temporary quantities + REAL(SiKi) :: cylinderLength, x, y, angle + INTEGER(IntKi) :: i, j + INTEGER(IntKi) :: errStat2 + CHARACTER(ErrMsgLen) :: errMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SetVTKDefaultBladeParams' + integer, parameter :: N = 66 + ! default airfoil shape coordinates; uses S809 values from http://wind.nrel.gov/airfoils/Shapes/S809_Shape.html: + real, parameter, dimension(N) :: xc=(/ 1.0,0.996203,0.98519,0.967844,0.945073,0.917488,0.885293,0.848455,0.80747,0.763042,0.715952,0.667064,0.617331,0.56783,0.519832,0.474243,0.428461,0.382612,0.33726,0.29297,0.250247,0.209576,0.171409,0.136174,0.104263,0.076035,0.051823,0.03191,0.01659,0.006026,0.000658,0.000204,0.0,0.000213,0.001045,0.001208,0.002398,0.009313,0.02323,0.04232,0.065877,0.093426,0.124111,0.157653,0.193738,0.231914,0.271438,0.311968,0.35337,0.395329,0.438273,0.48192,0.527928,0.576211,0.626092,0.676744,0.727211,0.776432,0.823285,0.86663,0.905365,0.938474,0.965086,0.984478,0.996141,1.0 /) + real, parameter, dimension(N) :: yc=(/ 0.0,0.000487,0.002373,0.00596,0.011024,0.017033,0.023458,0.03028,0.037766,0.045974,0.054872,0.064353,0.074214,0.084095,0.093268,0.099392,0.10176,0.10184,0.10007,0.096703,0.091908,0.085851,0.078687,0.07058,0.061697,0.052224,0.042352,0.032299,0.02229,0.012615,0.003723,0.001942,-0.00002,-0.001794,-0.003477,-0.003724,-0.005266,-0.011499,-0.020399,-0.030269,-0.040821,-0.051923,-0.063082,-0.07373,-0.083567,-0.092442,-0.099905,-0.105281,-0.108181,-0.108011,-0.104552,-0.097347,-0.086571,-0.073979,-0.060644,-0.047441,-0.0351,-0.024204,-0.015163,-0.008204,-0.003363,-0.000487,0.000743,0.000775,0.00029,0.0 /) + call AllocAry(BladeShape%AirfoilCoords, 2, N, M%NNodes, 'BladeShape%AirfoilCoords', errStat2, errMsg2) + CALL SetErrStat(errStat2,errMsg2,errStat,errMsg,RoutineName) + IF (errStat >= AbortErrLev) RETURN + ! Chord length and pitch axis location are given by scaling law + bladeLength = TwoNorm( M%position(:,tipNode) - M%Position(:,rootNode) ) + cylinderLength = TwoNorm( M%Position(:,cylNode) - M%Position(:,rootNode) ) + bladeLengthFract = 0.22*bladeLength + bladeLengthFract2 = bladeLength-bladeLengthFract != 0.78*bladeLength + DO i=1,M%Nnodes + posLength = TwoNorm( M%Position(:,i) - M%Position(:,rootNode) ) + IF (posLength .LE. bladeLengthFract) THEN + ratio = posLength/bladeLengthFract + chord = (0.06 + 0.02*ratio)*bladeLength + pitchAxis = 0.25 + 0.125*ratio + ELSE + chord = (0.08 - 0.06*(posLength-bladeLengthFract)/bladeLengthFract2)*bladeLength + pitchAxis = 0.375 + END IF + if(present(BlChord)) then + chord = BlChord(i) + endif + IF (posLength .LE. cylinderLength) THEN + ! create a cylinder for this node + chord = chord/2.0_SiKi + DO j=1,N + ! normalized x,y coordinates for airfoil + x = yc(j) + y = xc(j) - 0.5 + angle = ATAN2( y, x) + ! x,y coordinates for cylinder + BladeShape%AirfoilCoords(1,j,i) = chord*COS(angle) ! x (note that "chord" is really representing chord/2 here) + BladeShape%AirfoilCoords(2,j,i) = chord*SIN(angle) ! y (note that "chord" is really representing chord/2 here) + END DO + ELSE + ! create an airfoil for this node + DO j=1,N + ! normalized x,y coordinates for airfoil, assuming an upwind turbine + x = yc(j) + y = xc(j) - pitchAxis + ! x,y coordinates for airfoil + BladeShape%AirfoilCoords(1,j,i) = chord*x + BladeShape%AirfoilCoords(2,j,i) = chord*y + END DO + END IF + END DO ! nodes on mesh + +END SUBROUTINE AD_SetVTKDefaultBladeParams subroutine calcCantAngle(f, xi,stencilSize,n,cantAngle) diff --git a/modules/aerodyn/src/AeroDyn_Inflow.f90 b/modules/aerodyn/src/AeroDyn_Inflow.f90 new file mode 100644 index 0000000000..7a1da9b7df --- /dev/null +++ b/modules/aerodyn/src/AeroDyn_Inflow.f90 @@ -0,0 +1,688 @@ +!> Module for the coupling of AeroDyn and InflowWind +!! Also contains routine to couple with a "Fake ElastoDyn" (minimalistic structural solver) +module AeroDyn_Inflow + use NWTC_Library + use AeroDyn_Inflow_Types + use AeroDyn_Types + use AeroDyn, only: AD_Init, AD_ReInit, AD_CalcOutput, AD_UpdateStates + use AeroDyn, only: AD_NumWindPoints, AD_GetExternalWind, AD_SetExternalWindPositions + use AeroDyn_IO, only: AD_SetVTKSurface + use InflowWind, only: InflowWind_Init, InflowWind_CalcOutput + + implicit none + + private + + type(ProgDesc), parameter :: ADI_Ver = ProgDesc( 'ADI', '', '' ) + + public :: ADI_Init + public :: ADI_ReInit + public :: ADI_End + public :: ADI_CalcOutput + public :: ADI_UpdateStates + + ! Convenient routines for driver + public :: ADI_ADIW_Solve + public :: concatOutputHeaders + public :: Init_MeshMap_For_ADI + public :: Set_Inputs_For_ADI + + real(ReKi), parameter :: myNaN = -99.9_ReKi +contains + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine is called at the start of the simulation to perform initialization steps. +!! The parameters are set here and not changed during the simulation. +!! The initial states and initial guess for the input are defined. +subroutine ADI_Init(InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut, errStat, errMsg) + type(ADI_InitInputType), intent(inout) :: InitInp !< Input data for initialization routine (inout so we can use MOVE_ALLOC) + type(ADI_InputType), intent( out) :: u !< An initial guess for the input; input mesh must be defined + type(ADI_ParameterType), intent( out) :: p !< Parameters + type(ADI_ContinuousStateType), intent( out) :: x !< Initial continuous states + type(ADI_DiscreteStateType), intent( out) :: xd !< Initial discrete states + type(ADI_ConstraintStateType), intent( out) :: z !< Initial guess of the constraint states + type(ADI_OtherStateType), intent( out) :: OtherState !< Initial other states + type(ADI_OutputType), intent( out) :: y !< Initial system outputs (outputs are not calculated; + type(ADI_MiscVarType), intent( out) :: m !< Initial misc/optimization variables + real(DbKi), intent(inout) :: interval !< Coupling interval in seconds + type(ADI_InitOutputType), intent(inout) :: InitOut !< Output for initialization routine. NOTE: inout to allow for reinit? + integer(IntKi), intent( out) :: errStat !< Error status of the operation + character(*), intent( out) :: errMsg !< Error message if errStat /= ErrID_None + ! Local variables + type(InflowWind_InitOutputType) :: InitOut_IW ! Output data from initialization + type(AD_InitOutputType) :: InitOut_AD ! Output data from initialization + integer(IntKi) :: errStat2 ! temporary error status of the operation + character(errMsgLen) :: errMsg2 ! temporary error message + + ! Initialize variables for this routine + errStat = ErrID_None + errMsg = "" + + ! Initialize the NWTC Subroutine Library + call NWTC_Init( EchoLibVer=.FALSE. ) + + ! Display the module information + call DispNVD( ADI_Ver ) + + ! Set parameters + p%dt = interval + p%storeHHVel = InitInp%storeHHVel + p%WrVTK = InitInp%WrVTK + + ! --- Initialize AeroDyn + if (allocated(InitOut%WriteOutputHdr)) deallocate(InitOut%WriteOutputHdr) + if (allocated(InitOut%WriteOutputUnt)) deallocate(InitOut%WriteOutputUnt) + + call AD_Init(InitInp%AD, u%AD, p%AD, x%AD, xd%AD, z%AD, OtherState%AD, y%AD, m%AD, Interval, InitOut_AD, errStat2, errMsg2); if (Failed()) return + InitOut%Ver = InitOut_AD%ver + ! Add writeoutput units and headers to driver, same for all cases and rotors! + !TODO: this header is too short if we add more rotors. Should also add a rotor identifier + call concatOutputHeaders(InitOut%WriteOutputHdr, InitOut%WriteOutputUnt, InitOut_AD%rotors(1)%WriteOutputHdr, InitOut_AD%rotors(1)%WriteOutputUnt, errStat2, errMsg2); if(Failed()) return + + ! --- Initialize Inflow Wind + call ADI_InitInflowWind(InitInp%RootName, InitInp%IW_InitInp, u%AD, OtherState%AD, m%IW, Interval, InitOut_IW, errStat2, errMsg2); if (Failed()) return + ! Concatenate AD outputs to IW outputs + call concatOutputHeaders(InitOut%WriteOutputHdr, InitOut%WriteOutputUnt, InitOut_IW%WriteOutputHdr, InitOut_IW%WriteOutputUnt, errStat2, errMsg2); if(Failed()) return + + ! --- Initialize grouped outputs + !TODO: assumes one rotor + p%NumOuts = p%AD%rotors(1)%NumOuts + p%AD%rotors(1)%BldNd_TotNumOuts + m%IW%p%NumOuts + call AllocAry(y%WriteOutput, p%NumOuts, 'WriteOutput', errStat2, errMsg2); if (Failed()) return + + ! --- Initialize outputs + call AllocAry(y%IW_WriteOutput, size(m%IW%y%WriteOutput),'IW_WriteOutput', errStat2, errMsg2); if(Failed()) return + y%IW_WriteOutput = myNaN + if (p%storeHHVel) then + call AllocAry(y%HHVel, 3, size(InitInp%AD%rotors), 'HHVel', errStat2, errMsg2); if(Failed()) return + y%HHVel= myNaN + else + call AllocAry(y%HHVel, 0, 0 , 'HHVel', errStat2, errMsg2); if(Failed()) return + endif + + ! --- Initialize VTK + if (p%WrVTK>0) then + call AD_SetVTKSurface(InitOut_AD, u%AD, m%VTK_Surfaces, errStat2, errMsg2); if(Failed()) return + endif + + call cleanup() + +contains + + subroutine cleanup() + call AD_DestroyInitInput (InitInp%AD, errStat2, errMsg2) + call AD_DestroyInitOutput(InitOut_AD, errStat2, errMsg2) + call InflowWind_DestroyInitOutput(InitOut_IW, errStat2, errMsg2) + end subroutine cleanup + + logical function Failed() + call SetErrStat(errStat2, errMsg2, errStat, errMsg, 'ADI_Init') + Failed = errStat >= AbortErrLev + if (Failed) call cleanup() + end function Failed + +end subroutine ADI_Init +!---------------------------------------------------------------------------------------------------------------------------------- +!> ReInit +subroutine ADI_ReInit(p, x, xd, z, OtherState, m, Interval, errStat, errMsg) + type(ADI_ParameterType), intent(in ) :: p !< Parameters + type(ADI_ContinuousStateType), intent(inout) :: x !< Initial continuous states + type(ADI_DiscreteStateType), intent(inout) :: xd !< Initial discrete states + type(ADI_ConstraintStateType), intent(inout) :: z !< Initial guess of the constraint states + type(ADI_OtherStateType), intent(inout) :: OtherState !< Initial other states + type(ADI_MiscVarType), intent(inout) :: m !< Initial misc/optimization variables + real(DbKi), intent(inout) :: interval !< Coupling interval in seconds + integer(IntKi), intent( out) :: errStat !< Error status of the operation + character(*), intent( out) :: errMsg !< Error message if errStat /= ErrID_None + ! Local variables + integer(IntKi) :: errStat2 ! temporary error status of the operation + character(errMsgLen) :: errMsg2 ! temporary error message + errStat = ErrID_None + errMsg = "" + + ! Reinitialize AeroDyn without reopening input file + call AD_ReInit(p%AD, x%AD, xd%AD, z%AD, OtherState%AD, m%AD, Interval, errStat2, errMsg2); if(Failed()) return + ! Set parameters + !p%dt = interval ! dt shouldn't change +contains + + logical function Failed() + call SetErrStat(errStat2, errMsg2, errStat, errMsg, 'ADI_ReInit') + Failed = errStat >= AbortErrLev + end function Failed + +end subroutine ADI_ReInit +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine is called at the end of the simulation. +subroutine ADI_End( u, p, x, xd, z, OtherState, y, m, errStat, errMsg ) + type(ADI_InputType), intent(inout) :: u(:) !< System inputs NOTE: used to be allocatable + type(ADI_ParameterType), intent(inout) :: p !< Parameters + type(ADI_ContinuousStateType), intent(inout) :: x !< Continuous states + type(ADI_DiscreteStateType), intent(inout) :: xd !< Discrete states + type(ADI_ConstraintStateType), intent(inout) :: z !< Constraint states + type(ADI_OtherStateType), intent(inout) :: OtherState !< Other states + type(ADI_OutputType), intent(inout) :: y !< System outputs + type(ADI_MiscVarType), intent(inout) :: m !< Misc/optimization variables + integer(IntKi), intent( out) :: errStat !< Error status of the operation + character(*), intent( out) :: errMsg !< Error message if errStat /= ErrID_None + integer(IntKi) :: i + errStat = ErrID_None + errMsg = "" + + ! Destroy the input data: + !if (allocated(u)) then + do i=1,size(u) + call ADI_DestroyInput( u(i), errStat, errMsg ) + enddo + !endif + + ! Destroy the parameter data: + call ADI_DestroyParam( p, errStat, errMsg ) + + ! Destroy the state data: + call ADI_DestroyContState( x, errStat, errMsg ) + call ADI_DestroyDiscState( xd, errStat, errMsg ) + call ADI_DestroyConstrState( z, errStat, errMsg ) + call ADI_DestroyOtherState( OtherState, errStat, errMsg ) + call ADI_DestroyMisc( m, errStat, errMsg ) + + ! Destroy the output data: + call ADI_DestroyOutput( y, errStat, errMsg ) + +end subroutine ADI_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 ADI_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(ADI_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(ADI_ParameterType), intent(in ) :: p !< Parameters + type(ADI_ContinuousStateType), intent(inout) :: x !< Input: Continuous states at t; Output: at t+DTaero + type(ADI_DiscreteStateType), intent(inout) :: xd !< Input: Discrete states at t; Output: at t+DTaero + type(ADI_ConstraintStateType), intent(inout) :: z !< Input: Constraint states at t; Output: at t+DTaero + type(ADI_OtherStateType), intent(inout) :: OtherState !< Input: Other states at t; Output: at t+DTaero + type(ADI_MiscVarType), intent(inout) :: m !< Misc/optimization variables + integer(IntKi), intent( out) :: errStat !< Error status of the operation + character(*), intent( out) :: errMsg !< Error message if errStat /= ErrID_None + ! local variables + integer :: it ! Index on times + type(AD_InputType) :: u_AD(size(utimes)) + integer(IntKi) :: errStat2 ! temporary Error status + character(errMsgLen) :: errMsg2 ! temporary Error message + !type(ADI_InputType) :: uInterp ! Interpolated/Extrapolated input + errStat = ErrID_None + errMsg = "" + + ! Compute InflowWind inputs for each time + do it=1,size(utimes) + call AD_CopyInput(u(it)%AD,u_AD(it),MESH_NEWCOPY,ErrStat2,ErrMsg2); if(Failed()) return + enddo + + ! 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 + +contains + + subroutine CleanUp() + !call ADI_DestroyConstrState(z_guess, errStat2, errMsg2); if(Failed()) return + end subroutine + + logical function Failed() + call SetErrStat(errStat2, errMsg2, errStat, errMsg, 'ADI_UpdateStates') + Failed = errStat >= AbortErrLev + if (Failed) call CleanUp() + end function Failed + +end subroutine ADI_UpdateStates +!---------------------------------------------------------------------------------------------------------------------------------- +!> Routine for computing outputs, used in both loose and tight coupling. +subroutine ADI_CalcOutput(t, u, p, x, xd, z, OtherState, y, m, errStat, errMsg) + real(DbKi), intent(in ) :: t !< Current simulation time in seconds + type(ADI_InputType), intent(inout) :: u !< Inputs at Time t ! NOTE: set as in-out since "Inflow" needs to be set + type(ADI_ParameterType), intent(in ) :: p !< Parameters + type(ADI_ContinuousStateType), intent(in ) :: x !< Continuous states at t + type(ADI_DiscreteStateType), intent(in ) :: xd !< Discrete states at t + type(ADI_ConstraintStateType), intent(in ) :: z !< Constraint states at t + type(ADI_OtherStateType), intent(in ) :: OtherState !< Other states at t + type(ADI_OutputType), intent(inout) :: y !< Outputs computed at t (Input only so that mesh con- + !! nectivity information does not have to be recalculated) + type(ADI_MiscVarType), intent(inout) :: m !< Misc/optimization variables + integer(IntKi), intent( out) :: errStat !< Error status of the operation + character(*), intent( out) :: errMsg !< Error message if errStat /= ErrID_None + ! Local variables + integer(IntKi) :: errStat2 + character(errMsgLen) :: errMsg2 + character(*), parameter :: RoutineName = 'ADI_CalcOutput' + integer :: iWT + errStat = ErrID_None + errMsg = "" + + ! --- CalcOutputs for IW (Sets u_AD%rotors(:)%InflowOnBlade, etc, and m%IW%y) + y%IW_WriteOutput(:) = m%IW%y%WriteOutput(:) + + + ! Calculate outputs at t + call AD_CalcOutput(t, u%AD, p%AD, x%AD, xd%AD, z%AD, OtherState%AD, y%AD, m%AD, errStat2, errMsg2); if(Failed()) return + + ! --- Outputs for driver + ! Hub Height velocity outputs + if (p%storeHHVel) then + do iWT = 1, size(p%AD%rotors) + y%HHVel(1, iWT) = m%IW%y%VelocityUVW(1, iWT) + y%HHVel(2, iWT) = m%IW%y%VelocityUVW(2, iWT) + y%HHVel(3, iWT) = m%IW%y%VelocityUVW(3, iWT) + enddo + endif + y%PLExp = m%IW%PLExp + + ! --- Set outputs +!TODO: this assumes one rotor!!! + y%WriteOutput(1:p%AD%rotors(1)%NumOuts+p%AD%rotors(1)%BldNd_TotNumOuts) = y%AD%rotors(1)%WriteOutput(1:p%AD%rotors(1)%NumOuts+p%AD%rotors(1)%BldNd_TotNumOuts) + y%WriteOutput(p%AD%rotors(1)%NumOuts+p%AD%rotors(1)%BldNd_TotNumOuts+1:p%NumOuts) = y%IW_WriteOutput(1:m%IW%p%NumOuts) + +contains + + subroutine CleanUp() + !call ADI_DestroyConstrState(z_guess, errStat2, errMsg2); if(Failed()) return + end subroutine + + logical function Failed() + call SetErrStat(errStat2, errMsg2, errStat, errMsg, 'ADI_CalcOutput') + Failed = errStat >= AbortErrLev + if (Failed) call CleanUp() + end function Failed +end subroutine ADI_CalcOutput +!---------------------------------------------------------------------------------------------------------------------------------- +!> +subroutine ADI_InitInflowWind(Root, i_IW, u_AD, o_AD, IW, dt, InitOutData, errStat, errMsg) + use InflowWind, only: InflowWind_Init + character(len=*), intent(in ) :: Root ! Rootname for input files + type(ADI_IW_InputData), intent(in ) :: i_IW ! Inflow Wind "pseudo init input" data + type(AD_InputType), intent(in ) :: u_AD ! AeroDyn data + type(AD_OtherStateType), intent(in ) :: o_AD ! AeroDyn data + type(ADI_InflowWindData), intent(inout) :: IW ! InflowWind data + real(DbKi), intent(inout) :: dt ! interval + type(InflowWind_InitOutputType), intent(out) :: InitOutData ! Output data from initialization + integer(IntKi) , intent( out) :: errStat ! Status of error message + character(*) , intent( out) :: errMsg ! Error message if errStat /= ErrID_None + ! locals + integer(IntKi) :: errStat2 ! local status of error message + character(errMsgLen) :: errMsg2 ! local error message if errStat /= ErrID_None + type(InflowWind_InitInputType) :: InitInData ! Input data for initialization + errStat = ErrID_None + errMsg = '' + + ! --- Count number of points required by AeroDyn + InitInData%NumWindPoints = AD_NumWindPoints(u_AD, o_AD) + ! Adding Hub windspeed for each turbine + InitInData%NumWindPoints = InitInData%NumWindPoints + size(u_AD%rotors) + + ! --- Init InflowWind + if (i_IW%CompInflow==0) then + ! Fake "InflowWind" init + allocate(InitOutData%WriteOutputHdr(0)) + allocate(InitOutData%WriteOutputUnt(0)) + allocate(IW%y%WriteOutput(0)) + call AllocAry(IW%u%PositionXYZ, 3, InitInData%NumWindPoints, 'PositionXYZ', errStat2, errMsg2); if (Failed()) return + call AllocAry(IW%y%VelocityUVW, 3, InitInData%NumWindPoints, 'VelocityUVW', errStat2, errMsg2); if (Failed()) return + IW%u%PositionXYZ = myNaN + IW%y%VelocityUVW = myNaN + else + ! Module init + InitInData%InputFileName = i_IW%InputFile + InitInData%Linearize = i_IW%Linearize + InitInData%UseInputFile = i_IW%UseInputFile + if (.not. i_IW%UseInputFile) then + call NWTC_Library_Copyfileinfotype( i_IW%PassedFileData, InitInData%PassedFileData, MESH_NEWCOPY, errStat2, errMsg2 ); if (Failed()) return + endif + InitInData%RootName = Root + CALL InflowWind_Init( InitInData, IW%u, IW%p, & + IW%x, IW%xd, IW%z, IW%OtherSt, & + IW%y, IW%m, dt, InitOutData, errStat2, errMsg2 ) + if(Failed()) return + + endif + ! --- Store main init input data (data that don't use InfloWind directly) + IW%CompInflow = i_IW%CompInflow + IW%HWindSpeed = i_IW%HWindSpeed + IW%RefHt = i_IW%RefHt + IW%PLExp = i_IW%PLExp + + call cleanup() +contains + subroutine cleanup() + call InflowWind_DestroyInitInput( InitInData, errStat2, errMsg2 ) + end subroutine cleanup + + logical function Failed() + CALL SetErrStat( errStat2, errMsg2, errStat, errMsg, 'ADI_InitInflowWind' ) + Failed = errStat >= AbortErrLev + if (Failed) call cleanup() + end function Failed +end subroutine ADI_InitInflowWind +!---------------------------------------------------------------------------------------------------------------------------------- +!> Concatenate new output channels info to the extisting ones in the driver +subroutine concatOutputHeaders(WriteOutputHdr0, WriteOutputUnt0, WriteOutputHdr, WriteOutputUnt, errStat, errMsg) + character(ChanLen), dimension(:), allocatable, intent(inout) :: WriteOutputHdr0 !< Channel headers + character(ChanLen), dimension(:), allocatable, intent(inout) :: WriteOutputUnt0 !< Channel units + character(ChanLen), dimension(:), allocatable, intent(inout) :: WriteOutputHdr !< Channel headers + character(ChanLen), dimension(:), allocatable, intent(inout) :: WriteOutputUnt !< Channel units + integer(IntKi) , intent( out) :: errStat !< Status of error message + character(*) , intent( out) :: errMsg !< Error message if errStat /= ErrID_None + ! Locals + character(ChanLen), allocatable :: TmpHdr(:) + character(ChanLen), allocatable :: TmpUnt(:) + integer :: nOld, nAdd + errStat = ErrID_None + errMsg = '' + !print*,'>>> Concat',allocated(WriteOutputHdr0), allocated(WriteOutputUnt0), allocated(WriteOutputHdr), allocated(WriteOutputUnt) + if (.not.allocated(WriteOutputHdr)) return + if (.not.allocated(WriteOutputHdr0)) then + call move_alloc(WriteOutputHdr, WriteOutputHdr0) + call move_alloc(WriteOutputUnt, WriteOutputUnt0) + else + nOld = size(WriteOutputHdr0) + nAdd = size(WriteOutputHdr) + + call move_alloc(WriteOutputHdr0, TmpHdr) + call move_alloc(WriteOutputUnt0, TmpUnt) + + allocate(WriteOutputHdr0(nOld+nAdd)) + allocate(WriteOutputUnt0(nOld+nAdd)) + WriteOutputHdr0(1:nOld) = TmpHdr + WriteOutputUnt0(1:nOld) = TmpUnt + WriteOutputHdr0(nOld+1:nOld+nAdd) = WriteOutputHdr + WriteOutputUnt0(nOld+1:nOld+nAdd) = WriteOutputUnt + deallocate(TmpHdr) + deallocate(TmpUnt) + endif +end subroutine concatOutputHeaders +!---------------------------------------------------------------------------------------------------------------------------------- +!> Solve for the wind speed at the location necessary for AeroDyn +subroutine ADI_ADIW_Solve(t, u_AD, o_AD, u_IfW, IW, hubHeightFirst, errStat, errMsg) + real(DbKi), intent(in ) :: t ! Time of evaluation + type(AD_InputType), intent(inout) :: u_AD ! AeroDyn data + type(AD_OtherStateType), intent(in ) :: o_AD ! AeroDyn data + type(InflowWind_InputType), intent(inout) :: u_IfW ! InflowWind data + type(ADI_InflowWindData), intent(inout) :: IW ! InflowWind data + logical, intent(in ) :: hubHeightFirst ! Hub Height velocity is packed at beginning + integer(IntKi) , intent( out) :: errStat ! Status of error message + character(*) , intent( out) :: errMsg ! Error message if errStat /= ErrID_None + integer(IntKi) :: errStat2 ! Status of error message + character(errMsgLen) :: errMsg2 ! Error message if errStat /= ErrID_None + errStat = ErrID_None + errMsg = '' + + ! Set u_ifW%PositionXYZ + call ADI_Set_IW_Inputs(u_AD, o_AD, u_IfW, hubHeightFirst, errStat2, errMsg2); if(Failed()) return + ! Compute IW%y%VelocityUVW + call ADI_CalcOutput_IW(t, u_IfW, IW, errStat2, errMsg2); if(Failed()) return + ! Set u_AD%..%InflowOnBlade, u_AD%..%InflowOnTower, etc + call ADI_AD_InputSolve_IfW(u_AD, IW%y, hubHeightFirst, errStat2, errMsg2); if(Failed()) return + +contains + logical function Failed() + call SetErrStat(errStat2, errMsg2, errStat, errMsg, 'ADI_ADIW_Solve') + Failed = errStat >= AbortErrLev + end function Failed +end subroutine ADI_ADIW_Solve +!---------------------------------------------------------------------------------------------------------------------------------- +!> Set inputs for inflow wind +subroutine ADI_Set_IW_Inputs(u_AD, o_AD, u_IfW, hubHeightFirst, errStat, errMsg) + type(AD_InputType), intent(in ) :: u_AD ! AeroDyn data + type(AD_OtherStateType), intent(in ) :: o_AD ! AeroDyn data + type(InflowWind_InputType), intent(inout) :: u_IfW ! InflowWind data + logical, intent(in ) :: hubHeightFirst ! Hub Height velocity is packed at beginning + integer(IntKi) , intent( out) :: errStat ! Status of error message + character(*) , intent( out) :: errMsg ! Error message if errStat /= ErrID_None + integer :: K, J, node, iWT + errStat = ErrID_None + errMsg = '' + node=0 + + if (hubHeightFirst) then + ! Hub Height point for each turbine + do iWT=1,size(u_AD%rotors) + node = node + 1 + u_IfW%PositionXYZ(:,node) = u_AD%rotors(iWT)%hubMotion%Position(:,1) + u_AD%rotors(iWT)%hubMotion%TranslationDisp(:,1) + enddo + endif + call AD_SetExternalWindPositions(u_AD, o_AD, u_IfW%PositionXYZ, node, errStat, errMsg) + +end subroutine ADI_Set_IW_Inputs +!---------------------------------------------------------------------------------------------------------------------------------- +!---------------------------------------------------------------------------------------------------------------------------------- +!> Calculate Wind at desired points +!! NOTE: order is important and should match AD_NumWindPoints +!! Similar to FAST_Solver, IfW_InputSolve +subroutine ADI_CalcOutput_IW(t, u_IfW, IW, errStat, errMsg) + real(DbKi), intent(in ) :: t ! Time of evaluation + type(InflowWind_InputType), intent(inout) :: u_IfW ! InflowWind data + type(ADI_InflowWindData), intent(inout) :: IW ! InflowWind data + integer(IntKi) , intent( out) :: errStat ! Status of error message + character(*) , intent( out) :: errMsg ! Error message if errStat /= ErrID_None + integer :: j + real(ReKi) :: z + integer(IntKi) :: errStat2 ! Status of error message + character(errMsgLen) :: errMsg2 ! Error message if errStat /= ErrID_None + errStat = ErrID_None + errMsg = '' + if (IW%CompInflow==1) then + call InflowWind_CalcOutput(t, u_IfW, IW%p, IW%x, IW%xd, IW%z, IW%OtherSt, IW%y, IW%m, errStat2, errMsg2) + call SetErrStat(errStat2, errMsg2, errStat, errMsg, 'ADI_CalcOutput_IW') + else + do j=1,size(u_IfW%PositionXYZ,2) + z = u_IfW%PositionXYZ(3,j) + IW%y%VelocityUVW(1,j) = IW%HWindSpeed*(z/IW%RefHt)**IW%PLExp + IW%y%VelocityUVW(2,j) = 0.0_ReKi !V + IW%y%VelocityUVW(3,j) = 0.0_ReKi !W + end do + endif +end subroutine ADI_CalcOutput_IW +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine sets the wind claculated by InflowWind to the AeroDyn arrays +!! See similar routine in FAST_Solver +!! TODO put this in AeroDyn +subroutine ADI_AD_InputSolve_IfW(u_AD, y_IfW, hubHeightFirst, errStat, errMsg) + ! Passed variables + TYPE(AD_InputType), INTENT(INOUT) :: u_AD !< The inputs to AeroDyn + TYPE(InflowWind_OutputType), INTENT(IN) :: y_IfW !< The outputs from InflowWind + logical, intent(in ) :: hubHeightFirst ! Hub Height velocity is packed at beginning + INTEGER(IntKi) :: errStat !< Error status of the operation + CHARACTER(*) :: errMsg !< Error message if errStat /= ErrID_None + ! Local variables: + INTEGER(IntKi) :: J ! Loops through nodes / elements. + INTEGER(IntKi) :: K ! Loops through blades. + INTEGER(IntKi) :: NumBl + INTEGER(IntKi) :: NNodes + INTEGER(IntKi) :: node + INTEGER(IntKi) :: iWT + errStat = ErrID_None + errMsg = "" + node = 1 + ! Order important! + if (hubHeightFirst) then + do iWT=1,size(u_AD%rotors) + node = node + 1 ! Hub velocities for each rotor + enddo + endif + call AD_GetExternalWind(u_AD, y_IfW%VelocityUVW, node, errStat, errMsg) + +end subroutine ADI_AD_InputSolve_IfW + + + +! --------------------------------------------------------------------------------} +! --- ROUTINES RELEVANT FOR COUPLING WITH "FED": Fake ElastoDyn +! --------------------------------------------------------------------------------{ +!> Initialize the mesh mappings between the structure and aerodyn +!! Also adjust the tower mesh so that is is aligned with the tower base and tower top +!! Similar to FAST_Solver.f90, InitModuleMappings +subroutine Init_MeshMap_For_ADI(FED, uAD, errStat, errMsg) + type(FED_Data), target, intent(inout) :: FED ! Elastic wind turbine data (Fake ElastoDyn) + type(AD_InputType), intent(inout) :: uAD ! AeroDyn input data + integer(IntKi) , intent( out) :: errStat ! Status of error message + character(*) , intent( out) :: errMsg ! Error message if errStat /= ErrID_None + ! locals + real(ReKi) :: pos(3), Pbase(3), Ptop(3), DeltaP(3) + real(R8Ki) :: orientation(3,3) + real(ReKi) :: twrHeightAD , twrHeight + real(ReKi) :: zBar ! dimensionsless tower height + integer(IntKi) :: iWT, iB, i + integer(IntKi) :: errStat2 ! local status of error message + character(ErrMsgLen) :: errMsg2 ! local error message if errStat /= ErrID_None + type(RotFED), pointer :: y_ED ! Alias to shorten notation + errStat = ErrID_None + errMsg = '' + + ! --- Create Mappings from structure to AeroDyn + do iWT=1,size(FED%WT) + y_ED => FED%WT(iWT) + ! hub 2 hubAD + call MeshMapCreate(y_ED%HubPtMotion, uAD%rotors(iWT)%hubMotion, y_ED%ED_P_2_AD_P_H, errStat2, errMsg2); if(Failed())return + + ! nac 2 nacAD + call MeshMapCreate(y_ED%NacelleMotion, uAD%rotors(iWT)%nacelleMotion, y_ED%ED_P_2_AD_P_N, errStat2, errMsg2); if(Failed())return + + ! nac 2 tfinAD + if (uAD%rotors(iWT)%TFinMotion%Committed) then + call MeshMapCreate(y_ED%NacelleMotion, uAD%rotors(iWT)%TFinMotion, y_ED%ED_P_2_AD_P_TF, errStat2, errMsg2); if(Failed())return + endif + + ! bldroot 2 bldroot AD + allocate(y_ED%ED_P_2_AD_P_R(y_ED%numBlades)) + do iB = 1, y_ED%numBlades + call MeshMapCreate(y_ED%BladeRootMotion(iB), uAD%rotors(iWT)%BladeRootMotion(iB), y_ED%ED_P_2_AD_P_R(iB), errStat2, errMsg2); if(Failed())return + enddo + + if (y_ED%rigidBlades) then + ! TODO Only for Rigid + ! AD bld root 2 AD blade line + allocate(y_ED%AD_P_2_AD_L_B(y_ED%numBlades)) + do iB = 1, y_ED%numBlades + call MeshMapCreate(uAD%rotors(iWT)%BladeRootMotion(iB), uAD%rotors(iWT)%BladeMotion(iB), y_ED%AD_P_2_AD_L_B(iB), errStat2, errMsg2); if(Failed())return + enddo + else + print*,'>>> Init_MeshMap_For_ADI, TODO coupling with elastic blades' + STOP + endif + + if (uAD%rotors(iWT)%TowerMotion%nNodes>0) then + if (y_ED%hasTower) then + twrHeightAD=uAD%rotors(iWT)%TowerMotion%Position(3,uAD%rotors(iWT)%TowerMotion%nNodes)-uAD%rotors(iWT)%TowerMotion%Position(3,1) + ! Check tower height + if (twrHeightAD<0) then + errStat=ErrID_Fatal + errMsg='First AeroDyn tower height should be smaller than last AD tower height' + endif + + twrHeightAD=uAD%rotors(iWT)%TowerMotion%Position(3,uAD%rotors(iWT)%TowerMotion%nNodes) ! NOTE: assuming start a z=0 + + twrHeight=TwoNorm(y_ED%NacelleMotion%Position(:,1) - y_ED%TwrPtMesh%Position(:,1) ) + ! KEEP ME, in summary file + !print*,'Tower Height',twrHeight, twrHeightAD + if (abs(twrHeightAD-twrHeight)> twrHeight*0.1) then + errStat=ErrID_Fatal + errMsg='More than 10% difference between AeroDyn tower length ('//trim(num2lstr(twrHeightAD))//& + 'm), and the distance from tower base to nacelle ('//trim(num2lstr(twrHeight))//'m) for turbine '//trim(num2lstr(iWT)) + endif + + ! Adjust tower position (AeroDyn return values assuming (0,0,0) for tower base + Pbase = y_ED%TwrPtMesh%Position(:,1) + Ptop = y_ED%NacelleMotion%Position(:,1) + DeltaP = Ptop-Pbase + do i = 1, uAD%rotors(iWT)%TowerMotion%nNodes + zBar = uAD%rotors(iWT)%TowerMotion%Position(3,i)/twrHeight + uAD%rotors(iWT)%TowerMotion%Position(:,i)= Pbase+ zBar * DeltaP + uAD%rotors(iWT)%TowerMotion%RefOrientation(:,:,i)= y_ED%TwrPtMesh%RefOrientation(:,:,1) + enddo + ! Create AD tower base point mesh + pos = y_ED%TwrPtMesh%Position(:,1) + orientation = y_ED%TwrPtMesh%RefOrientation(:,:,1) + call Eye(orientation, errStat2, errMsg2) + call CreatePointMesh(y_ED%TwrPtMeshAD, pos, orientation, errStat2, errMsg2, hasMotion=.True., hasLoads=.False.); if(Failed())return + + ! TowerBase to AD tower base + call MeshMapCreate(y_ED%TwrPtMesh, y_ED%TwrPtMeshAD, y_ED%ED_P_2_AD_P_T, errStat2, errMsg2); if(Failed()) return + + ! AD TowerBase to AD tower line + call MeshMapCreate(y_ED%TwrPtMeshAD, uAD%rotors(iWT)%TowerMotion, y_ED%AD_P_2_AD_L_T, errStat2, errMsg2); if(Failed()) return + endif ! hasTower + else + ! Do Nothing for now + endif + + enddo ! Loop on WT/rotors + +contains + + logical function Failed() + call SetErrStat(errStat2, errMsg2, errStat, errMsg, 'Init_MeshMap_For_ADI') + Failed = errStat >= AbortErrLev + end function Failed +end subroutine Init_MeshMap_For_ADI +!---------------------------------------------------------------------------------------------------------------------------------- +!> Set aerodyn inputs based on FED meshes +! - set AD input meshes and inflow +subroutine Set_Inputs_For_ADI(u_ADI, FED, errStat, errMsg) + type(ADI_InputType), intent(inout) :: u_ADI !< AeroDyn/InflowWind Data inputs + type(FED_Data), target, intent(inout) :: FED !< Elastic wind turbine data (Fake ElastoDyn) + integer(IntKi) , intent( out) :: errStat !< Status of error message + character(*) , intent( out) :: errMsg !< Error message if errStat /= ErrID_None + ! local variables + integer(intKi) :: iWT ! loop counter for rotors + integer(intKi) :: iB ! loop counter for blades + integer(IntKi) :: errStat2 ! local status of error message + character(ErrMsgLen) :: errMsg2 ! local error message if errStat /= ErrID_None + type(RotFED), pointer :: y_ED ! Alias to shorten notation + errStat = ErrID_None + errMsg = "" + + ! --- Transfer motion from "ED" to AeroDyn + do iWT=1,size(FED%WT) + y_ED => FED%WT(iWT) + ! Hub 2 Hub AD + call Transfer_Point_to_Point(y_ED%HubPtMotion, u_ADI%AD%rotors(iWT)%hubMotion, y_ED%ED_P_2_AD_P_H, errStat2, errMsg2); if(Failed()) return + + ! Nac 2 Nac AD + call Transfer_Point_to_Point(y_ED%NacelleMotion, u_ADI%AD%rotors(iWT)%nacelleMotion, y_ED%ED_P_2_AD_P_N, errStat2, errMsg2); if(Failed()) return + + ! Nac 2 TailFin AD (Transfer ElastoDyn CM motion (taken as Nacelle) to AeroDyn tailfin ref point motion + if (u_ADI%AD%rotors(iWT)%TFinMotion%Committed) then + call Transfer_Point_to_Point( y_ED%NacelleMotion, u_ADI%AD%rotors(IWT)%TFinMotion, y_ED%ED_P_2_AD_P_TF, errStat2, errMsg2 ); if(Failed()) return + end if + + ! Blade root to blade root AD + do iB = 1,y_ED%numBlades + call Transfer_Point_to_Point(y_ED%BladeRootMotion(iB), u_ADI%AD%rotors(iWT)%BladeRootMotion(iB), y_ED%ED_P_2_AD_P_R(iB), errStat2, errMsg2); if(Failed()) return + enddo + + ! Blade root AD to blade line AD + if (y_ED%rigidBlades) then + do iB = 1,y_ED%numBlades + call Transfer_Point_to_Line2(u_ADI%AD%rotors(iWT)%BladeRootMotion(iB), u_ADI%AD%rotors(iWT)%BladeMotion(iB), y_ED%AD_P_2_AD_L_B(iB), errStat2, errMsg2); if(Failed()) return + enddo + else + print*,'>>> Set_Inputs_For_ADI: TODO Elastic Blades' + STOP + endif + + ! Tower motion + if (y_ED%hasTower) then + if (u_ADI%AD%rotors(iWT)%TowerMotion%nNodes>0) then + call Transfer_Point_to_Point(y_ED%TwrPtMesh, y_ED%TwrPtMeshAD, y_ED%ED_P_2_AD_P_T, errStat2, errMsg2); if(Failed()) return + call Transfer_Point_to_Line2(y_ED%TwrPtMeshAD, u_ADI%AD%rotors(iWT)%TowerMotion, y_ED%AD_P_2_AD_L_T, errStat2, errMsg2); if(Failed()) return + endif + endif + enddo ! iWT, rotors + +contains + logical function Failed() + call SetErrStat(errStat2, errMsg2, errStat, errMsg, 'Set_Inputs_For_ADI') + Failed = errStat >= AbortErrLev + end function Failed +end subroutine Set_Inputs_For_ADI + + +end module AeroDyn_Inflow diff --git a/modules/aerodyn/src/AeroDyn_Inflow_C_Binding.f90 b/modules/aerodyn/src/AeroDyn_Inflow_C_Binding.f90 new file mode 100644 index 0000000000..c6a73c112a --- /dev/null +++ b/modules/aerodyn/src/AeroDyn_Inflow_C_Binding.f90 @@ -0,0 +1,1882 @@ +!********************************************************************************************************************************** +! LICENSING +! Copyright (C) 2021 National Renewable Energy Lab +! +! This file is part of AeroDyn. +! +! Licensed under the Apache License, Version 2.0 (the "License"); +! you may not use this file except in compliance with the License. +! You may obtain a copy of the License at +! +! http://www.apache.org/licenses/LICENSE-2.0 +! +! Unless required by applicable law or agreed to in writing, software +! distributed under the License is distributed on an "AS IS" BASIS, +! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +! See the License for the specific language governing permissions and +! limitations under the License. +! +!********************************************************************************************************************************** +MODULE AeroDyn_Inflow_C_BINDING + + USE ISO_C_BINDING + USE AeroDyn_Inflow + USE AeroDyn_Inflow_Types + USE NWTC_Library + + IMPLICIT NONE + + PUBLIC :: AeroDyn_Inflow_C_Init + !PUBLIC :: AeroDyn_Inflow_C_ReInit + PUBLIC :: AeroDyn_Inflow_C_CalcOutput + PUBLIC :: AeroDyn_Inflow_C_UpdateStates + PUBLIC :: AeroDyn_Inflow_C_End + + !------------------------------------------------------------------------------------ + ! Debugging: debugverbose + ! 0 - none + ! 1 - some summary info + ! 2 - above + all position/orientation info + ! 3 - above + input files (if direct passed) + ! 4 - above + meshes + integer(IntKi), parameter :: debugverbose = 0 + + !------------------------------------------------------------------------------------ + ! Error handling + ! This must exactly match the value in the python-lib. If ErrMsgLen changes at + ! some point in the nwtc-library, this should be updated, but the logic exists + ! to correctly handle different lengths of the strings + integer(IntKi), parameter :: ErrMsgLen_C = 1025 + integer(IntKi), parameter :: IntfStrLen = 1025 ! length of other strings through the C interface + + !------------------------------------------------------------------------------------ + ! Potential issues + ! - if MaxADIOutputs is sufficiently large, we may overrun the buffer on the Python + ! side (OutputChannelNames_C,OutputChannelUnits_C). Don't have a good method to + ! check this in code yet. Might be best to pass the max length over to Init and + ! do some checks here. May also want to convert this to C_NULL_CHAR delimiter + ! instead of fixed width. + ! - NOTE: AD: MaxOutputs = 1291 + ! IfW: MaxOutputs = 59 + integer(IntKi), parameter :: MaxADIOutputs = 8000 + + !------------------------------------------------------------------------------------ + ! Data storage + ! All AeroDyn data is stored within the following data structures inside this + ! module. No data is stored within AeroDyn itself, but is instead passed in + ! from this module. This data is not available to the calling code unless + ! explicitly passed through the interface (derived types such as these are + ! non-trivial to pass through the c-bindings). + !------------------------------ + ! Extrapolation and interpolation + ! For the solver in AD, previous timesteps input must be stored for extrapolation + ! to the t+dt timestep. This can be either linear (1) quadratic (2). The + ! InterpOrder variable tracks what this is and sets the size of the inputs `u` + ! passed into AD. Inputs `u` will be sized as follows: + ! linear interp u(2) with inputs at T,T-dt + ! quadratic interp u(3) with inputs at T,T-dt,T-2*dt + integer(IntKi) :: InterpOrder + !------------------------------ + ! Primary AD derived data types + type(ADI_InputType), allocatable :: u(:) !< Inputs at T, T-dt, T-2*dt (history kept for updating states) + type(ADI_InitInputType) :: InitInp !< Initialization data + type(ADI_InitOutputType) :: InitOutData !< Initial output data -- Names, units, and version info. + type(ADI_ParameterType) :: p !< Parameters + type(ADI_ContinuousStateType) :: x(0:2) !< continuous states at Time t and t+dt (predicted) + type(ADI_DiscreteStateType) :: xd(0:2) !< discrete states at Time t and t+dt (predicted) + type(ADI_ConstraintStateType) :: z(0:2) !< Constraint states at Time t and t+dt (predicted) + type(ADI_OtherStateType) :: OtherStates(0:2) !< Initial other/optimization states + type(ADI_OutputType) :: y !< Initial output (outputs are not calculated; only the output mesh is initialized) + type(ADI_MiscVarType) :: m !< Misc variables for optimization (not copied in glue code) + !------------------------------ + ! Time tracking + ! When we are performing a correction step, time information of previous + ! calls is needed to decide how to apply correction logic or cycle the inputs + ! and resave the previous timestep states. + ! Correction steps + ! OpenFAST has the ability to perform correction steps. During a correction + ! step, new input values are passed in but the timestep remains the same. + ! When this occurs the new input data at time t is used with the state + ! information from the previous timestep (t) to calculate new state values + ! time t+dt in the UpdateStates routine. In OpenFAST this is all handled by + ! the glue code. However, here we do not pass state information through the + ! interface and therefore must store it here analogously to how it is handled + ! in the OpenFAST glue code. + real(DbKi) :: dT_Global ! dT of the code calling this module + integer(IntKi) :: N_Global ! global timestep + real(DbKi) :: T_Initial ! initial Time of simulation + real(DbKi) :: TMax ! initial Time of simulation + real(DbKi), allocatable :: InputTimes(:) ! input times corresponding to u(:) array + real(DbKi) :: InputTimePrev ! input time of last UpdateStates call + ! Note that we are including the previous state info here (not done in OF this way) + integer(IntKi), parameter :: STATE_LAST = 0 ! Index for previous state (not needed in OF, but necessary here) + integer(IntKi), parameter :: STATE_CURR = 1 ! Index for current state + integer(IntKi), parameter :: STATE_PRED = 2 ! Index for predicted state + ! Note the indexing is different on inputs (no clue why, but thats how OF handles it) + integer(IntKi), parameter :: INPUT_LAST = 3 ! Index for previous input at t-dt + integer(IntKi), parameter :: INPUT_CURR = 2 ! Index for current input at t + integer(IntKi), parameter :: INPUT_PRED = 1 ! Index for predicted input at t+dt + !------------------------------------------------------------------------------------ + + + + !------------------------------------------------------------------------------------ + ! Meshes for motions and loads + ! Meshes are used within AD to handle all motions and loads. Rather than directly + ! map to those nodes, we will create a mapping to go between the array of node + ! positions passed into this module and what is used inside AD. This is done + ! through a pair of meshes for the motion and loads corresponding to the node + ! positions passed in. + !------------------------------ + ! Meshes for external nodes + ! These point meshes are merely used to simplify the mapping of motions/loads + ! to/from AD using the library mesh mapping routines. These meshes may contain + ! one or multiple points. + ! - 1 point -- rigid floating body assumption + ! - N points -- flexible structure (either floating or fixed bottom) + integer(IntKi) :: NumTurbines = 1 ! Number of turbines (only one at present) + integer(IntKi) :: NumBlades ! Number of blades (only one rotor allowed at present) + integer(IntKi) :: NumMeshPts ! Number of mesh points we are interfacing motions/loads to/from AD + type(MeshType) :: BldPtMotionMesh ! mesh for motions of external nodes + type(MeshType) :: BldPtLoadMesh ! mesh for loads for external nodes + type(MeshType) :: BldPtLoadMesh_tmp ! mesh for loads for external nodes -- temporary +! type(MeshType) :: NacMotionMesh ! mesh for motion of nacelle -- TODO: add this mesh for nacelle load transfers +! type(MeshType) :: NacLoadMesh ! mesh for loads for nacelle loads -- TODO: add this mesh for nacelle load transfers + integer(IntKi) :: WrVTK !< Write VTK outputs [0: none, 1: init only, 2: animation] + integer(IntKi) :: WrVTK_Type !< Write VTK outputs as [1: surface, 2: lines, 3: both] + real(SiKi) :: VTKNacDim(6) !< Nacelle dimension passed in for VTK surface rendering [0,y0,z0,Lx,Ly,Lz] (m) + real(SiKi) :: VTKHubrad !< Hub radius for VTK surface rendering + real(SiKi) :: VTK_RefPos(3) = (/ 0.0_SiKi, 0.0_SiKi, 0.0_SiKi /) !TODO: should this be an input? + integer(IntKi) :: VTK_tWidth !< width of the time field in the VTK + character(IntfStrLen) :: VTK_OutFileRoot !< Root name to use for echo files, vtk, etc. + logical :: TransposeDCM !< Transpose DCMs as passed in -- test the vtk outputs to see if needed + !------------------------------ + ! Mesh mapping: motions + ! The mapping of motions from the nodes passed in to the corresponding AD meshes + type(MeshMapType), allocatable :: Map_BldPtMotion_2_AD_Blade(:) ! Mesh mapping between input motion mesh for blade +! type(MeshMapType) :: Map_AD_Nac_2_NacPtLoad ! Mesh mapping between input motion mesh for nacelle + !------------------------------ + ! Mesh mapping: loads + ! The mapping of loads from the AD meshes to the corresponding external nodes + type(MeshMapType), allocatable :: Map_AD_BldLoad_P_2_BldPtLoad(:) ! Mesh mapping between AD output blade line2 load to BldPtLoad for return +! type(MeshMapType) :: Map_NacPtMotion_2_AD_Nac ! Mesh mapping between AD output nacelle pt load to NacLoad for return + ! Motions input (so we don't have to reallocate all the time + real(ReKi), allocatable :: tmpBldPtMeshPos(:,:) ! temp array. Probably don't need this, but makes conversion from C clearer. + real(ReKi), allocatable :: tmpBldPtMeshOri(:,:,:) ! temp array. Probably don't need this, but makes conversion from C clearer. + real(ReKi), allocatable :: tmpBldPtMeshVel(:,:) ! temp array. Probably don't need this, but makes conversion from C clearer. + real(ReKi), allocatable :: tmpBldPtMeshAcc(:,:) ! temp array. Probably don't need this, but makes conversion from C clearer. + real(ReKi), allocatable :: tmpBldPtMeshFrc(:,:) ! temp array. Probably don't need this, but makes conversion to C clearer. + !------------------------------------------------------------------------------------ + + !------------------------------------------------------------------------------------ + ! Visualization + ! The data stored here is a duplicate of DvrVTK_BLSurfaceType from the AeroDyn_Driver_Registry. This + ! is a temporary solution to get visualization up and running with ADI_C. Ultimately this data will + ! be combined into the ADI library, but that won't happen right now. + ! ========= DvrVTK_SurfaceType ======= + TYPE, PUBLIC :: DvrVTK_SurfaceType + INTEGER(IntKi) :: NumSectors !< number of sectors in which to split circles (higher number gives smoother surface) [-] + REAL(SiKi) , DIMENSION(1:3,1:8) :: NacelleBox !< X-Y-Z locations of 8 points that define the nacelle box, relative to the nacelle position [m] + REAL(SiKi) , DIMENSION(1:3,1:8) :: BaseBox !< X-Y-Z locations of 8 points that define the base box [m] + END TYPE DvrVTK_SurfaceType + ! ======================= + type(DvrVTK_SurfaceType), allocatable :: VTK_surface(:) + !------------------------------------------------------------------------------------ + + +CONTAINS + +!> This routine sets the error status in C_CHAR for export to calling code. +!! Make absolutely certain that we do not overrun the end of ErrMsg_C. That is hard coded to 1025, +!! but ErrMsgLen is set in the nwtc_library, and could change without updates here. We don't want an +!! inadvertant buffer overrun -- that can lead to bad things. +subroutine SetErr(ErrStat, ErrMsg, ErrStat_C, ErrMsg_C) + integer, intent(in ) :: ErrStat !< aggregated error message (fortran type) + character(ErrMsgLen), intent(in ) :: ErrMsg !< aggregated error message (fortran type) + integer(c_int), intent( out) :: ErrStat_C + character(kind=c_char), intent( out) :: ErrMsg_C(ErrMsgLen_C) + integer :: i + ErrStat_C = ErrStat ! We will send back the same error status that is used in OpenFAST + if (ErrMsgLen > ErrMsgLen_C-1) then ! If ErrMsgLen is > the space in ErrMsg_C, do not copy everything over + ErrMsg_C = TRANSFER( trim(ErrMsg(1:ErrMsgLen_C-1))//C_NULL_CHAR, ErrMsg_C ) + else + ErrMsg_C = TRANSFER( trim(ErrMsg)//C_NULL_CHAR, ErrMsg_C ) + endif +end subroutine SetErr + + +!=============================================================================================================== +!--------------------------------------------- AeroDyn Init---------------------------------------------------- +!=============================================================================================================== +SUBROUTINE AeroDyn_Inflow_C_Init( ADinputFilePassed, ADinputFileString_C, ADinputFileStringLength_C, & + IfWinputFilePassed, IfWinputFileString_C, IfWinputFileStringLength_C, OutRootName_C, & + gravity_C, defFldDens_C, defKinVisc_C, defSpdSound_C, & + defPatm_C, defPvap_C, WtrDpth_C, MSL2SWL_C, & + AeroProjMod_C, & + InterpOrder_C, T_initial_C, DT_C, TMax_C, & + storeHHVel, TransposeDCM_in, & + WrVTK_in, WrVTK_inType, VTKNacDim_in, VTKHubRad_in, & + HubPos_C, HubOri_C, & + NacPos_C, NacOri_C, & + NumBlades_C, BldRootPos_C, BldRootOri_C, & + NumMeshPts_C, InitMeshPos_C, InitMeshOri_C, & + NumChannels_C, OutputChannelNames_C, OutputChannelUnits_C, & + ErrStat_C, ErrMsg_C) BIND (C, NAME='AeroDyn_Inflow_C_Init') + implicit none +#ifndef IMPLICIT_DLLEXPORT +!DEC$ ATTRIBUTES DLLEXPORT :: AeroDyn_Inflow_C_Init +!GCC$ ATTRIBUTES DLLEXPORT :: AeroDyn_Inflow_C_Init +#endif + ! Input file info + logical(c_bool), intent(in ) :: ADinputFilePassed !< Write VTK outputs [0: none, 1: init only, 2: animation] + type(c_ptr), intent(in ) :: ADinputFileString_C !< Input file as a single string with lines deliniated by C_NULL_CHAR + integer(c_int), intent(in ) :: ADinputFileStringLength_C !< lenght of the input file string + logical(c_bool), intent(in ) :: IfWinputFilePassed !< Write VTK outputs [0: none, 1: init only, 2: animation] + type(c_ptr), intent(in ) :: IfWinputFileString_C !< Input file as a single string with lines deliniated by C_NULL_CHAR + integer(c_int), intent(in ) :: IfWinputFileStringLength_C !< lenght of the input file string + character(kind=c_char), intent(in ) :: OutRootName_C(IntfStrLen) !< Root name to use for echo files and other + ! Environmental + real(c_float), intent(in ) :: gravity_C !< Gravitational acceleration (m/s^2) + real(c_float), intent(in ) :: defFldDens_C !< Air density (kg/m^3) + real(c_float), intent(in ) :: defKinVisc_C !< Kinematic viscosity of working fluid (m^2/s) + real(c_float), intent(in ) :: defSpdSound_C !< Speed of sound in working fluid (m/s) + real(c_float), intent(in ) :: defPatm_C !< Atmospheric pressure (Pa) [used only for an MHK turbine cavitation check] + real(c_float), intent(in ) :: defPvap_C !< Vapour pressure of working fluid (Pa) [used only for an MHK turbine cavitation check] + real(c_float), intent(in ) :: WtrDpth_C !< Water depth (m) + real(c_float), intent(in ) :: MSL2SWL_C !< Offset between still-water level and mean sea level (m) [positive upward] + ! Aero calculation method -- AeroProjMod + ! APM_BEM_NoSweepPitchTwist - 1 - "Original AeroDyn model where momentum balance is done in the WithoutSweepPitchTwist system" + ! APM_BEM_Polar - 2 - "Use staggered polar grid for momentum balance in each annulus" + ! APM_LiftingLine - 3 - "Use the blade lifting line (i.e. the structural) orientation (currently for OLAF with VAWT)" + integer(c_int), intent(in ) :: AeroProjMod_C !< Type of aerodynamic projection + ! Initial hub and blade root positions/orientations + real(c_float), intent(in ) :: HubPos_C( 3 ) !< Hub position + real(c_double), intent(in ) :: HubOri_C( 9 ) !< Hub orientation + real(c_float), intent(in ) :: NacPos_C( 3 ) !< Nacelle position + real(c_double), intent(in ) :: NacOri_C( 9 ) !< Nacelle orientation + integer(c_int), intent(in ) :: NumBlades_C !< Number of blades + real(c_float), intent(in ) :: BldRootPos_C( 3*NumBlades_C ) !< Blade root positions + real(c_double), intent(in ) :: BldRootOri_C( 9*NumBlades_C ) !< Blade root orientations + ! Initial nodes + integer(c_int), intent(in ) :: NumMeshPts_C !< Number of mesh points we are transfering motions to and output loads to + real(c_float), intent(in ) :: InitMeshPos_C( 3*NumMeshPts_C ) !< A 3xNumMeshPts_C array [x,y,z] + real(c_double), intent(in ) :: InitMeshOri_C( 9*NumMeshPts_C ) !< A 9xNumMeshPts_C array [r11,r12,r13,r21,r22,r23,r31,r32,r33] + ! Interpolation + integer(c_int), intent(in ) :: InterpOrder_C !< Interpolation order to use (must be 1 or 2) + ! Time + real(c_double), intent(in ) :: T_initial_C + real(c_double), intent(in ) :: DT_C !< Timestep used with AD for stepping forward from t to t+dt. Must be constant. + real(c_double), intent(in ) :: TMax_C !< Maximum time for simulation + ! Flags + logical(c_bool), intent(in ) :: storeHHVel !< Store hub height time series from IfW + logical(c_bool), intent(in ) :: TransposeDCM_in !< Transpose DCMs as they are passed in + ! VTK + integer(c_int), intent(in ) :: WrVTK_in !< Write VTK outputs [0: none, 1: init only, 2: animation] + integer(c_int), intent(in ) :: WrVTK_inType !< Write VTK outputs as [1: surface, 2: lines, 3: both] + real(c_float), intent(in ) :: VTKNacDim_in(6) !< Nacelle dimension passed in for VTK surface rendering [0,y0,z0,Lx,Ly,Lz] (m) + real(c_float), intent(in ) :: VTKHubrad_in !< Hub radius for VTK surface rendering + ! Output + integer(c_int), intent( out) :: NumChannels_C !< Number of output channels requested from the input file + character(kind=c_char), intent( out) :: OutputChannelNames_C(ChanLen*MaxADIOutputs+1) !< NOTE: if MaxADIOutputs is sufficiently large, we may overrun the buffer on the Python side. + character(kind=c_char), intent( out) :: OutputChannelUnits_C(ChanLen*MaxADIOutputs+1) + integer(c_int), intent( out) :: ErrStat_C !< Error status + character(kind=c_char), intent( out) :: ErrMsg_C(ErrMsgLen_C) !< Error message (C_NULL_CHAR terminated) + + ! Local Variable4 + character(IntfStrLen) :: OutRootName !< Root name to use for echo files and other + character(IntfStrLen) :: TmpFileName !< Temporary file name if not passing AD or IfW input file contents directly + character(kind=C_char, len=ADinputFileStringLength_C), pointer :: ADinputFileString !< Input file as a single string with NULL chracter separating lines + character(kind=C_char, len=IfWinputFileStringLength_C), pointer:: IfWinputFileString !< Input file as a single string with NULL chracter separating lines + + integer(IntKi) :: ErrStat !< aggregated error message + character(ErrMsgLen) :: ErrMsg !< aggregated error message + integer(IntKi) :: ErrStat2 !< temporary error status from a call + character(ErrMsgLen) :: ErrMsg2 !< temporary error message from a call + integer(IntKi) :: i,j,k !< generic counters + character(*), parameter :: RoutineName = 'AeroDyn_Inflow_C_Init' !< for error handling + + ! Initialize error handling + ErrStat = ErrID_None + ErrMsg = "" + NumChannels_C = 0_c_int + OutputChannelNames_C(:) = '' + OutputChannelUnits_C(:) = '' + + + !-------------------------- + ! Input files + !-------------------------- + ! RootName -- for output of echo or other files + OutRootName = TRANSFER( OutRootName_C, OutRootName ) + i = INDEX(OutRootName,C_NULL_CHAR) - 1 ! if this has a c null character at the end... + if ( i > 0 ) OutRootName = OutRootName(1:I) ! remove it + + + ! For debugging the interface: + if (debugverbose > 0) then + call ShowPassedData() + endif + + + ! Get fortran pointer to C_NULL_CHAR deliniated input files as a string + call C_F_pointer(ADinputFileString_C, ADinputFileString) + call C_F_pointer(IfWinputFileString_C, IfWinputFileString) + + ! Format AD input file contents + InitInp%AD%RootName = OutRootName + if (ADinputFilePassed) then + InitInp%AD%UsePrimaryInputFile = .FALSE. ! Don't try to read an input -- use passed data instead (blades and AF tables not passed) + InitInp%AD%InputFile = "passed_ad_file" ! not actually used + call InitFileInfo(ADinputFileString, InitInp%AD%PassedPrimaryInputData, ErrStat2, ErrMsg2); if (Failed()) return + else + InitInp%AD%UsePrimaryInputFile = .TRUE. ! Read input info from a primary input file + i = min(IntfStrLen,ADinputFileStringLength_C) + TmpFileName = '' + TmpFileName(1:i) = ADinputFileString(1:i) + i = INDEX(TmpFileName,C_NULL_CHAR) - 1 ! if this has a c null character at the end... + if ( i > 0 ) TmpFileName = TmpFileName(1:I) ! remove it + InitInp%AD%InputFile = TmpFileName + endif + + ! Format IfW input file contents + ! RootName is set in ADI_Init using AD%RootName + if (IfWinputFilePassed) then + InitInp%IW_InitInp%UseInputFile = .FALSE. ! Don't try to read an input -- use passed data instead (blades and AF tables not passed) + InitInp%IW_InitInp%InputFile = "passed_ifw_file" ! not actually used + call InitFileInfo(IfWinputFileString, InitInp%IW_InitInp%PassedFileData, ErrStat2, ErrMsg2); if (Failed()) return + else + InitInp%IW_InitINp%UseInputFile = .TRUE. ! Read input info from a primary input file + i = min(IntfStrLen,IfWinputFileStringLength_C) + TmpFileName = '' + TmpFileName(1:i) = IfWinputFileString(1:i) + i = INDEX(TmpFileName,C_NULL_CHAR) - 1 ! if this has a c null character at the end... + if ( i > 0 ) TmpFileName = TmpFileName(1:I) ! remove it + InitInp%IW_InitInp%InputFile = TmpFileName + endif + + + ! For diagnostic purposes, the following can be used to display the contents + ! of the InFileInfo data structure. + ! CU is the screen -- system dependent. + if (debugverbose >= 3) then + if (ADinputFilePassed) call Print_FileInfo_Struct( CU, InitInp%AD%PassedPrimaryInputData ) + if (IfWinputFilePassed) call Print_FileInfo_Struct( CU, InitInp%IW_InitInp%PassedFileData ) + endif + + + ! Store some data at library level + NumBlades = int(NumBlades_C, IntKi) + ! Timekeeping + dT_Global = REAL(DT_C, DbKi) + N_Global = 0_IntKi ! Assume we are on timestep 0 at start + t_initial = REAL(T_Initial_C, DbKi) + TMax = REAL(TMax_C, DbKi) + ! Interpolation order + InterpOrder = int(InterpOrder_C, IntKi) + if ( InterpOrder < 1_IntKi .or. InterpOrder > 2_IntKi ) then + ErrStat2 = ErrID_Fatal + ErrMsg2 = "InterpOrder passed into AeroDyn_Inflow_C_Init must be 1 (linear) or 2 (quadratic)" + if (Failed()) return + endif + ! VTK outputs + WrVTK = int(WrVTK_in, IntKi) + WrVTK_Type = int(WrVTK_inType, IntKi) + VTKNacDim = real(VTKNacDim_in, SiKi) + VTKHubrad = real(VTKHubrad_in, SiKi) + if ( WrVTK < 0_IntKi .or. WrVTK > 2_IntKi ) then + ErrStat2 = ErrID_Fatal + ErrMsg2 = "WrVTK option for writing VTK visualization files must be [0: none, 1: init only, 2: animation]" + if (Failed()) return + endif + if ( WrVTK_Type > 0_IntKi ) then + if ( WrVTK_Type < 1_IntKi .or. WrVTK_Type > 3_IntKi ) then + ErrStat2 = ErrID_Fatal + ErrMsg2 = "WrVTK_Type option for writing VTK visualization files must be [1: surface, 2: lines, 3: both]" + if (Failed()) return + endif + if (VTKHubRad < 0.0_SiKi) then + ErrStat2 = ErrID_Warn + ErrMsg2 = "VTKHubRad for surface visualization of hub less than zero. Setting to zero." + if (Failed()) return + VTKHubRad = 0.0_SiKi + endif + endif + ! Flag to transpose DCMs as they are passed in + TransposeDCM = TransposeDCM_in + + + ! Linearization + ! for now, set linearization to false. Pass this in later when interface supports it + InitInp%AD%Linearize = .FALSE. + !InitInp%IW_InitInp%Linearize = .FALSE. + + + ! AeroDyn values passed in through interface + InitInp%AD%Gravity = REAL(gravity_C, ReKi) + InitInp%AD%defFldDens = REAL(defFldDens_C, ReKi) + InitInp%AD%defKinVisc = REAL(defKinVisc_C, ReKi) + InitInp%AD%defSpdSound = REAL(defSpdSound_C, ReKi) + InitInp%AD%defPatm = REAL(defPatm_C, ReKi) + InitInp%AD%defPvap = REAL(defPvap_C, ReKi) + InitInp%AD%WtrDpth = REAL(WtrDpth_C, ReKi) + InitInp%AD%MSL2SWL = REAL(MSL2SWL_C, ReKi) + InitInp%storeHHVel = storeHHVel + InitInp%WrVTK = WrVTK + InitInp%WrVTK_Type = WrVTK_Type + InitInp%IW_InitInp%CompInflow = 1 ! Use InflowWind + + ! setup rotors for AD -- interface only supports one rotor at present + allocate (InitInp%AD%rotors(1),stat=errStat2) + if (errStat/=0) then + ErrStat2 = ErrID_Fatal + ErrMsg2 = 'Allocating rotors' + if (Failed()) return + end if + InitInp%AD%rotors(1)%AeroProjMod = int(AeroProjMod_C, IntKi) + InitInp%AD%rotors(1)%numBlades = NumBlades + call AllocAry(InitInp%AD%rotors(1)%BladeRootPosition, 3, NumBlades_c, 'BldRootPos', errStat2, errMsg2 ); if (Failed()) return + call AllocAry(InitInp%AD%rotors(1)%BladeRootOrientation, 3, 3, NumBlades_c, 'BldRootOri', errStat2, errMsg2 ); if (Failed()) return + InitInp%AD%rotors(1)%HubPosition = real(HubPos_C(1:3),ReKi) + InitInp%AD%rotors(1)%HubOrientation = reshape( real(HubOri_C(1:9),R8Ki), (/3,3/) ) + InitInp%AD%rotors(1)%NacellePosition = real(NacPos_C(1:3),ReKi) + InitInp%AD%rotors(1)%NacelleOrientation = reshape( real(NacOri_C(1:9),R8Ki), (/3,3/) ) + InitInp%AD%rotors(1)%BladeRootPosition = reshape( real(BldRootPos_C(1:3*NumBlades_c),ReKi), (/ 3,NumBlades_c/) ) + InitInp%AD%rotors(1)%BladeRootOrientation = reshape( real(BldRootOri_C(1:9*NumBlades_c),R8Ki), (/3,3,NumBlades_c/) ) + if (TransposeDCM) then + InitInp%AD%rotors(1)%HubOrientation = transpose(InitInp%AD%rotors(1)%HubOrientation) + InitInp%AD%rotors(1)%NacelleOrientation = transpose(InitInp%AD%rotors(1)%NacelleOrientation) + do i=1,NumBlades + InitInp%AD%rotors(1)%BladeRootOrientation(1:3,1:3,i) = transpose(InitInp%AD%rotors(1)%BladeRootOrientation(1:3,1:3,i)) + enddo + endif + + ! Remap the orientation DCM just in case there is some issue with passed + call OrientRemap(InitInp%AD%rotors(1)%HubOrientation) + call OrientRemap(InitInp%AD%rotors(1)%NacelleOrientation) + do i=1,NumBlades + call OrientRemap(InitInp%AD%rotors(1)%BladeRootOrientation(1:3,1:3,i)) + enddo + + + ! Number of blades and initial positions + ! - NumMeshPts is the number of interface Mesh points we are expecting on the python + ! side. Will validate this against what AD reads from the initialization info. + NumMeshPts = int(NumMeshPts_C, IntKi) + if (NumMeshPts < 1) then + ErrStat2 = ErrID_Fatal + ErrMsg2 = "At least one node point must be specified" + if (Failed()) return + endif + ! Allocate temporary arrays to simplify data conversions + call AllocAry( tmpBldPtMeshPos, 3, NumMeshPts, "tmpBldPtMeshPos", ErrStat2, ErrMsg2 ); if (Failed()) return + call AllocAry( tmpBldPtMeshOri, 3, 3, NumMeshPts, "tmpBldPtMeshOri", ErrStat2, ErrMsg2 ); if (Failed()) return + call AllocAry( tmpBldPtMeshVel, 6, NumMeshPts, "tmpBldPtMeshVel", ErrStat2, ErrMsg2 ); if (Failed()) return + call AllocAry( tmpBldPtMeshAcc, 6, NumMeshPts, "tmpBldPtMeshAcc", ErrStat2, ErrMsg2 ); if (Failed()) return + call AllocAry( tmpBldPtMeshFrc, 6, NumMeshPts, "tmpBldPtMeshFrc", ErrStat2, ErrMsg2 ); if (Failed()) return + tmpBldPtMeshPos( 1:3,1:NumMeshPts) = reshape( real(InitMeshPos_C(1:3*NumMeshPts),ReKi), (/ 3,NumMeshPts/) ) + tmpBldPtMeshOri(1:3,1:3,1:NumMeshPts) = reshape( real(InitMeshOri_C(1:9*NumMeshPts),ReKi), (/3,3,NumMeshPts/) ) + + + !---------------------------------------------------- + ! Allocate input array u and corresponding InputTimes + !---------------------------------------------------- + ! These inputs are used in the time stepping algorithm within AD_UpdateStates + ! For quadratic interpolation (InterpOrder==2), 3 timesteps are used. For + ! linear (InterOrder==1), 2 timesteps (the AD code can handle either). + ! u(1) inputs at t + ! u(2) inputs at t - dt + ! u(3) inputs at t - 2*dt ! quadratic only + allocate(u(InterpOrder+1), STAT=ErrStat2) + if (ErrStat2 /= 0) then + ErrStat2 = ErrID_Fatal + ErrMsg2 = "Could not allocate inuput" + if (Failed()) return + endif + call AllocAry( InputTimes, InterpOrder+1, "InputTimes", ErrStat2, ErrMsg2 ); if (Failed()) return + + + ! Call the main subroutine AeroDyn_Inflow_Init + ! dT_Global and InitInp are passed into AD_Init, all the rest are set by AD_Init + ! + ! NOTE: Pass u(1) only (this is empty and will be set inside Init). We will copy + ! this to u(2) and u(3) afterwards + call ADI_Init( InitInp, u(1), p, x(STATE_CURR), xd(STATE_CURR), z(STATE_CURR), OtherStates(STATE_CURR), y, m, dT_Global, InitOutData, ErrStat2, ErrMsg2 ) + if (Failed()) return + + + !------------------------------------------------------------- + ! Sanity checks + !------------------------------------------------------------- + call CheckNodes(ErrStat2,ErrMsg2); if (Failed()) return + + + !------------------------------------------------------------- + ! Set the interface meshes for motion inputs and loads output + !------------------------------------------------------------- + call SetMotionLoadsInterfaceMeshes(ErrStat2,ErrMsg2); if (Failed()) return + if (WrVTK > 0_IntKi) then + call SetVTKParameters(OutRootName,u(1)%AD%rotors(:),VTK_RefPos,ErrStat2,ErrMsg2) + if (Failed()) return + call WrVTK_refMeshes(u(1)%AD%rotors(:),VTK_RefPos,ErrStat2,ErrMsg2) + if (Failed()) return + endif + + !------------------------------------------------------------- + ! Setup other prior timesteps + ! We fill InputTimes with negative times, but the Input values are identical for each of those times; this allows + ! us to use, e.g., quadratic interpolation that effectively acts as a zeroth-order extrapolation and first-order extrapolation + ! for the first and second time steps. (The interpolation order in the ExtrapInput routines are determined as + ! order = SIZE(Input) + !------------------------------------------------------------- + do i=2,InterpOrder+1 + call ADI_CopyInput (u(1), u(i), MESH_NEWCOPY, Errstat2, ErrMsg2) + if (Failed()) return + enddo + do i = 1, InterpOrder + 1 + InputTimes(i) = t_initial - (i - 1) * dT_Global + enddo + InputTimePrev = InputTimes(1) - dT_Global ! Initialize for UpdateStates + + + !------------------------------------------------------------- + ! Initial setup of other pieces of x,xd,z,OtherStates + !------------------------------------------------------------- + CALL ADI_CopyContState ( x( STATE_CURR), x( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return + CALL ADI_CopyDiscState ( xd( STATE_CURR), xd( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return + CALL ADI_CopyConstrState( z( STATE_CURR), z( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return + CALL ADI_CopyOtherState ( OtherStates(STATE_CURR), OtherStates(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return + + !------------------------------------------------------------- + ! Setup the previous timestep copies of states + !------------------------------------------------------------- + CALL ADI_CopyContState ( x( STATE_CURR), x( STATE_LAST), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return + CALL ADI_CopyDiscState ( xd( STATE_CURR), xd( STATE_LAST), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return + CALL ADI_CopyConstrState( z( STATE_CURR), z( STATE_LAST), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return + CALL ADI_CopyOtherState ( OtherStates(STATE_CURR), OtherStates(STATE_LAST), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return + + + !TODO: Is there any other InitOutData should be returned? + + + !------------------------------------------------- + ! Set output channel information for driver code + !------------------------------------------------- + + ! Number of channels + NumChannels_C = size(InitOutData%WriteOutputHdr) + + ! transfer the output channel names and units to c_char arrays for returning + ! Upgrade idea: use C_NULL_CHAR as delimiters. Requires rework of Python + ! side of code. + k=1 + do i=1,NumChannels_C + do j=1,ChanLen ! max length of channel name. Same for units + OutputChannelNames_C(k)=InitOutData%WriteOutputHdr(i)(j:j) + OutputChannelUnits_C(k)=InitOutData%WriteOutputUnt(i)(j:j) + k=k+1 + enddo + enddo + + ! null terminate the string + OutputChannelNames_C(k) = C_NULL_CHAR + OutputChannelUnits_C(k) = C_NULL_CHAR + + + call SetErr(ErrStat,ErrMsg,ErrStat_C,ErrMsg_C) + + +CONTAINS + logical function Failed() + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Failed = ErrStat >= AbortErrLev + if (Failed) then + call FailCleanup() + call SetErr(ErrStat,ErrMsg,ErrStat_C,ErrMsg_C) + endif + end function Failed + + subroutine FailCleanup() + if (allocated(tmpBldPtMeshPos)) deallocate(tmpBldPtMeshPos) + if (allocated(tmpBldPtMeshOri)) deallocate(tmpBldPtMeshOri) + if (allocated(tmpBldPtMeshVel)) deallocate(tmpBldPtMeshVel) + if (allocated(tmpBldPtMeshAcc)) deallocate(tmpBldPtMeshAcc) + if (allocated(tmpBldPtMeshFrc)) deallocate(tmpBldPtMeshFrc) + end subroutine FailCleanup + + !> This subroutine prints out all the variables that are passed in. Use this only + !! for debugging the interface on the Fortran side. + subroutine ShowPassedData() + character(1) :: TmpFlag + integer :: i,j + call WrScr("Interface debugging: Variables passed in through interface") + call WrScr("-----------------------------------------------------------") + call WrScr(" FileInfo") + TmpFlag="F"; if (ADinputFilePassed) TmpFlag="T" + call WrScr(" ADinputFilePassed_C "//TmpFlag ) + call WrScr(" ADinputFileString_C (ptr addr) "//trim(Num2LStr(LOC(ADinputFileString_C))) ) + call WrScr(" ADinputFileStringLength_C "//trim(Num2LStr( ADinputFileStringLength_C )) ) + TmpFlag="F"; if (IfWinputFilePassed) TmpFlag="T" + call WrScr(" IfWinputFilePassed_C "//TmpFlag ) + call WrScr(" IfWinputFileString_C (ptr addr)"//trim(Num2LStr(LOC(IfWinputFileString_C))) ) + call WrScr(" IfWinputFileStringLength_C "//trim(Num2LStr( IfWinputFileStringLength_C )) ) + call WrScr(" OutRootName "//trim(OutRootName) ) + call WrScr(" Environment variables") + call WrScr(" gravity_C "//trim(Num2LStr( gravity_C )) ) + call WrScr(" defFldDens_C "//trim(Num2LStr( defFldDens_C )) ) + call WrScr(" defKinVisc_C "//trim(Num2LStr( defKinVisc_C )) ) + call WrScr(" defSpdSound_C "//trim(Num2LStr( defSpdSound_C )) ) + call WrScr(" defPatm_C "//trim(Num2LStr( defPatm_C )) ) + call WrScr(" defPvap_C "//trim(Num2LStr( defPvap_C )) ) + call WrScr(" WtrDpth_C "//trim(Num2LStr( WtrDpth_C )) ) + call WrScr(" MSL2SWL_C "//trim(Num2LStr( MSL2SWL_C )) ) + call WrScr(" Interpolation") + call WrScr(" InterpOrder_C "//trim(Num2LStr( InterpOrder_C )) ) + call WrScr(" Time variables") + call WrScr(" T_initial_C "//trim(Num2LStr( T_initial_C )) ) + call WrScr(" DT_C "//trim(Num2LStr( DT_C )) ) + call WrScr(" TMax_C "//trim(Num2LStr( TMax_C )) ) + call WrScr(" Flags") + TmpFlag="F"; if (storeHHVel) TmpFlag="T" + call WrScr(" storeHHVel "//TmpFlag ) + call WrScr(" WrVTK_in "//trim(Num2LStr( WrVTK_in )) ) + call WrScr(" WrVTK_inType "//trim(Num2LStr( WrVTK_inType )) ) + TmpFlag="F"; if (TransposeDCM_in) TmpFlag="T" + call WrScr(" TransposeDCM_in "//TmpFlag ) + call WrScr(" Init Data") + call WrNR(" Hub Position ") + call WrMatrix(HubPos_C,CU,'(3(ES15.7e2))') + call WrNR(" Hub Orientation ") + call WrMatrix(HubOri_C,CU,'(9(ES23.15e2))') + call WrNR(" Nacelle Position ") + call WrMatrix(NacPos_C,CU,'(3(ES15.7e2))') + call WrNR(" Nacelle Orientation ") + call WrMatrix(NacOri_C,CU,'(9(ES23.15e2))') + call WrScr(" NumBlades_C "//trim(Num2LStr( NumBlades_C )) ) + if (debugverbose > 1) then + call WrScr(" Root Positions") + do i=1,NumBlades_C + j=3*(i-1) + call WrMatrix(BldRootPos_C(j+1:j+3),CU,'(3(ES15.7e2))') + enddo + call WrScr(" Root Orientations") + do i=1,NumBlades_C + j=9*(i-1) + call WrMatrix(BldRootOri_C(j+1:j+9),CU,'(9(ES23.15e2))') + enddo + endif + call WrScr(" NumMeshPts_C "//trim(Num2LStr( NumMeshPts_C )) ) + if (debugverbose > 1) then + call WrScr(" Mesh Positions") + do i=1,NumMeshPts_C + j=3*(i-1) + call WrMatrix(InitMeshPos_C(j+1:j+3),CU,'(3(ES15.7e2))') + enddo + call WrScr(" Mesh Orientations") + do i=1,NumMeshPts_C + j=9*(i-1) + call WrMatrix(InitMeshOri_C(j+1:j+9),CU,'(9(ES23.15e2))') + enddo + endif + call WrScr("-----------------------------------------------------------") + end subroutine ShowPassedData + + !> This subroutine sets the interface meshes to map to the input motions to the AD + !! meshes + subroutine SetMotionLoadsInterfaceMeshes(ErrStat3,ErrMsg3) + integer(IntKi), intent( out) :: ErrStat3 !< temporary error status + character(ErrMsgLen), intent( out) :: ErrMsg3 !< temporary error message + integer(IntKi) :: iNode + real(ReKi) :: InitPos(3) + real(R8Ki) :: Orient(3,3) + !------------------------------------------------------------- + ! Set the interface meshes for motion inputs and loads output + !------------------------------------------------------------- + ! Motion mesh for blades + call MeshCreate( BldPtMotionMesh , & + IOS = COMPONENT_INPUT , & + Nnodes = NumMeshPts , & + ErrStat = ErrStat3 , & + ErrMess = ErrMsg3 , & + TranslationDisp = .TRUE., Orientation = .TRUE., & + TranslationVel = .TRUE., RotationVel = .TRUE., & + TranslationAcc = .TRUE., RotationAcc = .FALSE. ) + if (ErrStat3 >= AbortErrLev) return + + do iNode=1,NumMeshPts + ! initial position and orientation of node + InitPos = tmpBldPtMeshPos(1:3,iNode) + if (TransposeDCM) then + Orient = transpose(tmpBldPtMeshOri(1:3,1:3,iNode)) + else + Orient = tmpBldPtMeshOri(1:3,1:3,iNode) + endif + call OrientRemap(Orient) + call MeshPositionNode( BldPtMotionMesh , & + iNode , & + InitPos , & ! position + ErrStat3, ErrMsg3 , & + Orient ) ! orientation + if (ErrStat3 >= AbortErrLev) return +!FIXME: if we need to switch to line2 instead of point, do that here. + call MeshConstructElement ( BldPtMotionMesh, ELEMENT_POINT, ErrStat3, ErrMsg3, iNode ) + if (ErrStat3 >= AbortErrLev) return + enddo + + call MeshCommit ( BldPtMotionMesh, ErrStat3, ErrMsg3 ) + if (ErrStat3 >= AbortErrLev) return + BldPtMotionMesh%RemapFlag = .TRUE. + + ! For checking the mesh, uncomment this. + ! note: CU is is output unit (platform dependent). + if (debugverbose >= 4) call MeshPrintInfo( CU, BldPtMotionMesh, MeshName='BldPtMotionMesh' ) + + +! !------------------------------------------------------------- +! ! Motion mesh for nacelle -- TODO: add this mesh for nacelle load transfers +! call MeshCreate( NacMotionMesh , & +! IOS = COMPONENT_INPUT , & +! Nnodes = 1 , & +! ErrStat = ErrStat3 , & +! ErrMess = ErrMsg3 , & +! TranslationDisp = .TRUE., Orientation = .TRUE., & +! TranslationVel = .TRUE., RotationVel = .TRUE., & +! TranslationAcc = .TRUE., RotationAcc = .FALSE. ) +! if (ErrStat3 >= AbortErrLev) return +! +! InitPos = real(NacPos_C( 1:3),ReKi) +! Orient = reshape( real(NacOri_C(1:9),ReKi), (/3,3/) ) +! call OrientRemap(Orient) +! call MeshPositionNode( NacMotionMesh , & +! 1 , & +! InitPos , & ! position +! ErrStat3, ErrMsg3 , & +! Orient ) ! orientation +! if (ErrStat3 >= AbortErrLev) return +! +! call MeshConstructElement ( NacMotionMesh, ELEMENT_POINT, ErrStat3, ErrMsg3, p1=1 ) +! if (ErrStat3 >= AbortErrLev) return +! +! call MeshCommit ( NacMotionMesh, ErrStat3, ErrMsg3 ) +! if (ErrStat3 >= AbortErrLev) return +! NacMotionMesh%RemapFlag = .TRUE. +! +! ! For checking the mesh, uncomment this. +! ! note: CU is is output unit (platform dependent). +! if (debugverbose >= 4) call MeshPrintInfo( CU, NacMotionMesh, MeshName='NacMotionMesh' ) +! +! + !------------------------------------------------------------- + ! Load mesh for blades + CALL MeshCopy( SrcMesh = BldPtMotionMesh ,& + DestMesh = BldPtLoadMesh ,& + CtrlCode = MESH_SIBLING ,& + IOS = COMPONENT_OUTPUT ,& + ErrStat = ErrStat3 ,& + ErrMess = ErrMsg3 ,& + Force = .TRUE. ,& + Moment = .TRUE. ) + if (ErrStat3 >= AbortErrLev) return + BldPtLoadMesh%RemapFlag = .TRUE. + + ! Temp mesh for load transfer + CALL MeshCopy( SrcMesh = BldPtLoadMesh ,& + DestMesh = BldPtLoadMesh_tmp ,& + CtrlCode = MESH_COUSIN ,& + IOS = COMPONENT_OUTPUT ,& + ErrStat = ErrStat3 ,& + ErrMess = ErrMsg3 ,& + Force = .TRUE. ,& + Moment = .TRUE. ) + if (ErrStat3 >= AbortErrLev) return + BldPtLoadMesh_tmp%RemapFlag = .TRUE. + + + ! For checking the mesh + ! note: CU is is output unit (platform dependent). + if (debugverbose >= 4) call MeshPrintInfo( CU, BldPtLoadMesh, MeshName='BldPtLoadMesh' ) + + +! !------------------------------------------------------------- +! ! Load mesh for nacelle -- TODO: add this mesh for nacelle load transfers +! CALL MeshCopy( SrcMesh = NacMotionMesh ,& +! DestMesh = NacLoadMesh ,& +! CtrlCode = MESH_SIBLING ,& +! IOS = COMPONENT_OUTPUT ,& +! ErrStat = ErrStat3 ,& +! ErrMess = ErrMsg3 ,& +! Force = .TRUE. ,& +! Moment = .TRUE. ) +! if (ErrStat3 >= AbortErrLev) return +! NacLoadMesh%RemapFlag = .TRUE. +! +! ! For checking the mesh, uncomment this. +! ! note: CU is is output unit (platform dependent). +! if (debugverbose >= 4) call MeshPrintInfo( CU, NacLoadMesh, MeshName='NacLoadMesh' ) + + + !------------------------------------------------------------- + ! Set the mapping meshes + ! blades + allocate(Map_BldPtMotion_2_AD_Blade(NumBlades),Map_AD_BldLoad_P_2_BldPtLoad(NumBlades),STAT=ErrStat3) + if (ErrStat3 /= 0) then + ErrStat3 = ErrID_Fatal + ErrMsg3 = "Could not allocate Map_BldPtMotion_2_AD_Blade" + return + endif + do i=1,NumBlades + call MeshMapCreate( BldPtMotionMesh, u(1)%AD%rotors(1)%BladeMotion(i), Map_BldPtMotion_2_AD_Blade(i), ErrStat3, ErrMsg3 ) + if (ErrStat3 >= AbortErrLev) return + call MeshMapCreate( y%AD%rotors(1)%BladeLoad(i), BldPtLoadMesh, Map_AD_BldLoad_P_2_BldPtLoad(i), ErrStat3, ErrMsg3 ) + if (ErrStat3 >= AbortErrLev) return + enddo + ! nacelle -- TODO: add this mesh for nacelle load transfers +! if ( y%AD%rotors(1)%NacelleLoad%Committed ) then +! call MeshMapCreate( NacMotionMesh, u(1)%AD%rotors(1)%NacelleMotion, Map_NacPtMotion_2_AD_Nac, ErrStat3, ErrMsg3 ) +! if (ErrStat3 >= AbortErrLev) return +! call MeshMapCreate( y%AD%rotors(1)%NacelleLoad, NacLoadMesh, Map_AD_Nac_2_NacPtLoad, ErrStat3, ErrMsg3 ) +! if (ErrStat3 >= AbortErrLev) return +! endif + + end subroutine SetMotionLoadsInterfaceMeshes + + + !------------------------------------------------------------- + !> Sanity check the nodes + !! If more than one input node was passed in, but only a single AD node + !! exists, then give error that too many + !! nodes passed. + subroutine CheckNodes(ErrStat3,ErrMsg3) + integer(IntKi), intent( out) :: ErrStat3 !< temporary error status + character(ErrMsgLen), intent( out) :: ErrMsg3 !< temporary error message + ErrStat3 = ErrID_None + ErrMsg3 = "" + ! FIXME: this is a placeholder in case we think of some sanity checks to perform. + ! - some check that nodes make some sense -- might be caught in meshmapping + ! - some checks on hub/nacelle being near middle of the rotor? Not sure if that matters + end subroutine CheckNodes + +END SUBROUTINE AeroDyn_Inflow_C_Init + + +!!=============================================================================================================== +!!--------------------------------------------- AeroDyn ReInit--------------------------------------------------- +!!=============================================================================================================== +!!TODO: finish this routine so it is usable if we need re-init capability for coupling +!SUBROUTINE AeroDyn_Inflow_C_ReInit( T_initial_C, DT_C, TMax_C, & +! ErrStat_C, ErrMsg_C) BIND (C, NAME='AeroDyn_Inflow_C_ReInit') +! implicit none +!#ifndef IMPLICIT_DLLEXPORT +!!DEC$ ATTRIBUTES DLLEXPORT :: AeroDyn_Inflow_C_ReInit +!!GCC$ ATTRIBUTES DLLEXPORT :: AeroDyn_Inflow_C_ReInit +!#endif +! +! real(c_double), intent(in ) :: T_initial_C +! real(c_double), intent(in ) :: DT_C !< Timestep used with AD for stepping forward from t to t+dt. Must be constant. +! real(c_double), intent(in ) :: TMax_C !< Maximum time for simulation (used to set arrays for wave kinematics) +! integer(c_int), intent( out) :: ErrStat_C !< Error status +! character(kind=c_char), intent( out) :: ErrMsg_C(ErrMsgLen_C) !< Error message (C_NULL_CHAR terminated) +! +! integer(IntKi) :: ErrStat !< aggregated error message +! character(ErrMsgLen) :: ErrMsg !< aggregated error message +! integer(IntKi) :: ErrStat2 !< temporary error status from a call +! character(ErrMsgLen) :: ErrMsg2 !< temporary error message from a call +! character(*), parameter :: RoutineName = 'AeroDyn_Inflow_C_ReInit' !< for error handling +! +! ! Initialize error handling +! ErrStat = ErrID_None +! ErrMsg = "" +! +!ErrStat = ErrID_Fatal +!ErrMsg = "AeroDyn_Inflo_C_ReInit is not currently functional. Aborting." +!call SetErr(ErrStat,ErrMsg,ErrStat_C,ErrMsg_C) +! +! call ADI_ReInit(p, x(STATE_CURR), xd(STATE_CURR), z(STATE_CURR), OtherStates(STATE_CURR), m, dT_Global, errStat2, errMsg2) +! if (Failed()) return +! +! call SetErr(ErrStat,ErrMsg,ErrStat_C,ErrMsg_C) +! +!CONTAINS +! logical function Failed() +! CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) +! Failed = ErrStat >= AbortErrLev +! if (Failed) then +! call SetErr(ErrStat,ErrMsg,ErrStat_C,ErrMsg_C) +! endif +! end function Failed +!END SUBROUTINE AeroDyn_Inflow_C_ReInit + + +!=============================================================================================================== +!--------------------------------------------- AeroDyn CalcOutput --------------------------------------------- +!=============================================================================================================== + +SUBROUTINE AeroDyn_Inflow_C_CalcOutput(Time_C, & + HubPos_C, HubOri_C, HubVel_C, HubAcc_C, & + NacPos_C, NacOri_C, NacVel_C, NacAcc_C, & + BldRootPos_C, BldRootOri_C, BldRootVel_C, BldRootAcc_C, & + NumMeshPts_C, & + MeshPos_C, MeshOri_C, MeshVel_C, MeshAcc_C, & + MeshFrc_C, OutputChannelValues_C, ErrStat_C, ErrMsg_C) BIND (C, NAME='AeroDyn_Inflow_C_CalcOutput') + implicit none +#ifndef IMPLICIT_DLLEXPORT +!DEC$ ATTRIBUTES DLLEXPORT :: AeroDyn_Inflow_C_CalcOutput +!GCC$ ATTRIBUTES DLLEXPORT :: AeroDyn_Inflow_C_CalcOutput +#endif + real(c_double), intent(in ) :: Time_C + real(c_float), intent(in ) :: HubPos_C( 3 ) !< Hub position + real(c_double), intent(in ) :: HubOri_C( 9 ) !< Hub orientation + real(c_float), intent(in ) :: HubVel_C( 6 ) !< Hub velocity + real(c_float), intent(in ) :: HubAcc_C( 6 ) !< Hub acceleration + real(c_float), intent(in ) :: NacPos_C( 3 ) !< Nacelle position + real(c_double), intent(in ) :: NacOri_C( 9 ) !< Nacelle orientation + real(c_float), intent(in ) :: NacVel_C( 6 ) !< Nacelle velocity + real(c_float), intent(in ) :: NacAcc_C( 6 ) !< Nacelle acceleration + real(c_float), intent(in ) :: BldRootPos_C( 3*NumBlades ) !< Blade root positions + real(c_double), intent(in ) :: BldRootOri_C( 9*NumBlades ) !< Blade root orientations + real(c_float), intent(in ) :: BldRootVel_C( 6*NumBlades ) !< Blade root velocities + real(c_float), intent(in ) :: BldRootAcc_C( 6*NumBlades ) !< Blade root accelerations + ! Blade mesh nodes + integer(c_int), intent(in ) :: NumMeshPts_C !< Number of mesh points we are transfering motions to and output loads to + real(c_float), intent(in ) :: MeshPos_C( 3*NumMeshPts_C ) !< A 3xNumMeshPts_C array [x,y,z] + real(c_double), intent(in ) :: MeshOri_C( 9*NumMeshPts_C ) !< A 9xNumMeshPts_C array [r11,r12,r13,r21,r22,r23,r31,r32,r33] + real(c_float), intent(in ) :: MeshVel_C( 6*NumMeshPts_C ) !< A 6xNumMeshPts_C array [x,y,z] + real(c_float), intent(in ) :: MeshAcc_C( 6*NumMeshPts_C ) !< A 6xNumMeshPts_C array [x,y,z] + real(c_float), intent( out) :: MeshFrc_C( 6*NumMeshPts_C ) !< A 6xNumMeshPts_C array [Fx,Fy,Fz,Mx,My,Mz] -- forces and moments (global) + real(c_float), intent( out) :: OutputChannelValues_C(p%NumOuts) + integer(c_int), intent( out) :: ErrStat_C + character(kind=c_char), intent( out) :: ErrMsg_C(ErrMsgLen_C) + + ! Local variables + real(DbKi) :: Time + integer(IntKi) :: iNode + integer(IntKi) :: ErrStat !< aggregated error status + character(ErrMsgLen) :: ErrMsg !< aggregated error message + integer(IntKi) :: ErrStat2 !< temporary error status from a call + character(ErrMsgLen) :: ErrMsg2 !< temporary error message from a call + character(*), parameter :: RoutineName = 'AeroDyn_Inflow_C_CalcOutput' !< for error handling + + ! Initialize error handling + ErrStat = ErrID_None + ErrMsg = "" + + ! Sanity check -- number of node points cannot change + if ( NumMeshPts /= int(NumMeshPts_C, IntKi) ) then + ErrStat2 = ErrID_Fatal + ErrMsg2 = "Number of node points passed in changed. This must be constant throughout simulation" + if (Failed()) return + endif + + + ! Convert the inputs from C to Fortrn + Time = REAL(Time_C,DbKi) + + ! Reshape mesh position, orientation, velocity, acceleration + tmpBldPtMeshPos(1:3,1:NumMeshPts) = reshape( real(MeshPos_C(1:3*NumMeshPts),ReKi), (/3, NumMeshPts/) ) + tmpBldPtMeshOri(1:3,1:3,1:NumMeshPts) = reshape( real(MeshOri_C(1:9*NumMeshPts),R8Ki), (/3,3,NumMeshPts/) ) + tmpBldPtMeshVel(1:6,1:NumMeshPts) = reshape( real(MeshVel_C(1:6*NumMeshPts),ReKi), (/6, NumMeshPts/) ) + tmpBldPtMeshAcc(1:6,1:NumMeshPts) = reshape( real(MeshAcc_C(1:6*NumMeshPts),ReKi), (/6, NumMeshPts/) ) + + + ! Transfer motions to input meshes + call Set_MotionMesh( ErrStat2, ErrMsg2 ); if (Failed()) return + call AD_SetInputMotion( u(1), & + HubPos_C, HubOri_C, HubVel_C, HubAcc_C, & + NacPos_C, NacOri_C, NacVel_C, NacAcc_C, & + BldRootPos_C, BldRootOri_C, BldRootVel_C, BldRootAcc_C, & + ErrStat2, ErrMsg2 ) ! transfer input motion mesh to u(1) meshes + if (Failed()) return + + ! Call the main subroutine ADI_CalcOutput to get the resulting forces and moments at time T + CALL ADI_CalcOutput( Time, u(1), p, x(STATE_CURR), xd(STATE_CURR), z(STATE_CURR), OtherStates(STATE_CURR), y, m, ErrStat2, ErrMsg2 ) + if (Failed()) return + + ! Transfer resulting load meshes to intermediate mesh + call AD_TransferLoads( u(1), y, ErrStat2, ErrMsg2 ) + if (Failed()) return + + ! Set output force/moment array + call Set_OutputLoadArray( ) + MeshFrc_C(1:6*NumMeshPts) = reshape( real(tmpBldPtMeshFrc(1:6,1:NumMeshPts), c_float), (/6*NumMeshPts/) ) + + ! Get the output channel info out of y + OutputChannelValues_C = REAL(y%WriteOutput, C_FLOAT) + + ! Write VTK if requested (animation=2) + if (WrVTK > 1_IntKi) call WrVTK_Meshes(u(1)%AD%rotors(:),(/0.0_SiKi,0.0_SiKi,0.0_SiKi/),ErrStat2,ErrMsg2) + + ! Set error status + call SetErr(ErrStat,ErrMsg,ErrStat_C,ErrMsg_C) + +CONTAINS + logical function Failed() + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Failed = ErrStat >= AbortErrLev + if (Failed) call SetErr(ErrStat,ErrMsg,ErrStat_C,ErrMsg_C) + end function Failed +END SUBROUTINE AeroDyn_Inflow_C_CalcOutput + +!=============================================================================================================== +!--------------------------------------------- AeroDyn UpdateStates ------------------------------------------- +!=============================================================================================================== +!> This routine updates the states from Time_C to TimeNext_C. It is assumed that the inputs are given for +!! TimeNext_C, but will be checked against the previous timestep values. +!! Since we don't really know if we are doing correction steps or not, we will track the previous state and +!! reset to those if we are repeating a timestep (normally this would be handled by the OF glue code, but since +!! the states are not passed across the interface, we must handle them here). +SUBROUTINE AeroDyn_Inflow_C_UpdateStates( Time_C, TimeNext_C, & + HubPos_C, HubOri_C, HubVel_C, HubAcc_C, & + NacPos_C, NacOri_C, NacVel_C, NacAcc_C, & + BldRootPos_C, BldRootOri_C, BldRootVel_C, BldRootAcc_C, & + NumMeshPts_C, & + MeshPos_C, MeshOri_C, MeshVel_C, MeshAcc_C, & + ErrStat_C, ErrMsg_C) BIND (C, NAME='AeroDyn_Inflow_C_UpdateStates') + implicit none +#ifndef IMPLICIT_DLLEXPORT +!DEC$ ATTRIBUTES DLLEXPORT :: AeroDyn_Inflow_C_UpdateStates +!GCC$ ATTRIBUTES DLLEXPORT :: AeroDyn_Inflow_C_UpdateStates +#endif + real(c_double), intent(in ) :: Time_C + real(c_double), intent(in ) :: TimeNext_C + real(c_float), intent(in ) :: HubPos_C( 3 ) !< Hub position + real(c_double), intent(in ) :: HubOri_C( 9 ) !< Hub orientation + real(c_float), intent(in ) :: HubVel_C( 6 ) !< Hub velocity + real(c_float), intent(in ) :: HubAcc_C( 6 ) !< Hub acceleration + real(c_float), intent(in ) :: NacPos_C( 3 ) !< Nacelle position + real(c_double), intent(in ) :: NacOri_C( 9 ) !< Nacelle orientation + real(c_float), intent(in ) :: NacVel_C( 6 ) !< Nacelle velocity + real(c_float), intent(in ) :: NacAcc_C( 6 ) !< Nacelle acceleration + real(c_float), intent(in ) :: BldRootPos_C( 3*NumBlades ) !< Blade root positions + real(c_double), intent(in ) :: BldRootOri_C( 9*NumBlades ) !< Blade root orientations + real(c_float), intent(in ) :: BldRootVel_C( 6*NumBlades ) !< Blade root velocities + real(c_float), intent(in ) :: BldRootAcc_C( 6*NumBlades ) !< Blade root accelerations + ! Blade mesh nodes + integer(c_int), intent(in ) :: NumMeshPts_C !< Number of mesh points we are transfering motions to and output loads to + real(c_float), intent(in ) :: MeshPos_C( 3*NumMeshPts_C ) !< A 3xNumMeshPts_C array [x,y,z] + real(c_double), intent(in ) :: MeshOri_C( 9*NumMeshPts_C ) !< A 9xNumMeshPts_C array [r11,r12,r13,r21,r22,r23,r31,r32,r33] + real(c_float), intent(in ) :: MeshVel_C( 6*NumMeshPts_C ) !< A 6xNumMeshPts_C array [x,y,z] + real(c_float), intent(in ) :: MeshAcc_C( 6*NumMeshPts_C ) !< A 6xNumMeshPts_C array [x,y,z] + integer(c_int), intent( out) :: ErrStat_C + character(kind=c_char), intent( out) :: ErrMsg_C(ErrMsgLen_C) + + ! Local variables + logical :: CorrectionStep ! if we are repeating a timestep in UpdateStates, don't update the inputs array + integer(IntKi) :: iNode + integer(IntKi) :: ErrStat !< aggregated error status + character(ErrMsgLen) :: ErrMsg !< aggregated error message + integer(IntKi) :: ErrStat2 !< temporary error status from a call + character(ErrMsgLen) :: ErrMsg2 !< temporary error message from a call + character(*), parameter :: RoutineName = 'AeroDyn_Inflow_C_UpdateStates' !< for error handling + + ! Initialize error handling + ErrStat = ErrID_None + ErrMsg = "" + CorrectionStep = .false. + + ! Sanity check -- number of node points cannot change + if ( NumMeshPts /= int(NumMeshPts_C, IntKi) ) then + ErrStat2 = ErrID_Fatal + ErrMsg2 = "Number of node points passed in changed. This must be constant throughout simulation" + if (Failed()) return + endif + + + !------------------------------------------------------- + ! Check the time for current timestep and next timestep + !------------------------------------------------------- + ! These inputs are used in the time stepping algorithm within AD_UpdateStates + ! For quadratic interpolation (InterpOrder==2), 3 timesteps are used. For + ! linear (InterOrder==1), 2 timesteps (the AD code can handle either). + ! u(1) inputs at t + dt ! Next timestep + ! u(2) inputs at t ! This timestep + ! u(3) inputs at t - dt ! previous timestep (quadratic only) + ! + ! NOTE: Within AD, the Radiation calculations can be done at an integer multiple of the + ! timestep. This is checked at each UpdateStates call. However, if we compile + ! in double precision, the values of Time_C and TimeNext_C are in double precison, + ! but InputTimes is in DbKi (which is promoted quad precision when compiling in + ! double precision) and the check may fail. So we are going to set the times we + ! we pass over to UpdateStates using the global timestep and the stored DbKi value + ! for the timestep rather than the lower precision (when compiled double) time + ! values passed in. It is a bit of a clumsy workaround for this precision loss, + ! but should not affect any results. + + ! Check if we are repeating an UpdateStates call (for example in a predictor/corrector loop) + if ( EqualRealNos( real(Time_C,DbKi), InputTimePrev ) ) then + CorrectionStep = .true. + else ! Setup time input times array + InputTimePrev = real(Time_C,DbKi) ! Store for check next time + if (InterpOrder>1) then ! quadratic, so keep the old time + InputTimes(INPUT_LAST) = ( N_Global - 1 ) * dT_Global ! u(3) at T-dT + endif + InputTimes(INPUT_CURR) = N_Global * dT_Global ! u(2) at T + InputTimes(INPUT_PRED) = ( N_Global + 1 ) * dT_Global ! u(1) at T+dT + N_Global = N_Global + 1_IntKi ! increment counter to T+dT + endif + + + if (CorrectionStep) then + ! Step back to previous state because we are doing a correction step + ! -- repeating the T -> T+dt update with new inputs at T+dt + ! -- the STATE_CURR contains states at T+dt from the previous call, so revert those + CALL ADI_CopyContState (x( STATE_LAST), x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + CALL ADI_CopyDiscState (xd( STATE_LAST), xd( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + CALL ADI_CopyConstrState (z( STATE_LAST), z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + CALL ADI_CopyOtherState (OtherStates(STATE_LAST), OtherStates(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + else + ! Cycle inputs back one timestep since we are moving forward in time. + if (InterpOrder>1) then ! quadratic, so keep the old time + call ADI_CopyInput( u(INPUT_CURR), u(INPUT_LAST), MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + endif + ! Move inputs from previous t+dt (now t) to t + call ADI_CopyInput( u(INPUT_PRED), u(INPUT_CURR), MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + endif + + !------------------------------------------------------- + ! Set inputs for time T+dt -- u(INPUT_PRED) + !------------------------------------------------------- + ! Reshape mesh position, orientation, velocity, acceleration + tmpBldPtMeshPos(1:3,1:NumMeshPts) = reshape( real(MeshPos_C(1:3*NumMeshPts),ReKi), (/3, NumMeshPts/) ) + tmpBldPtMeshOri(1:3,1:3,1:NumMeshPts) = reshape( real(MeshOri_C(1:9*NumMeshPts),R8Ki), (/3,3,NumMeshPts/) ) + tmpBldPtMeshVel(1:6,1:NumMeshPts) = reshape( real(MeshVel_C(1:6*NumMeshPts),ReKi), (/6, NumMeshPts/) ) + tmpBldPtMeshAcc(1:6,1:NumMeshPts) = reshape( real(MeshAcc_C(1:6*NumMeshPts),ReKi), (/6, NumMeshPts/) ) + + ! Transfer motions to input meshes + call Set_MotionMesh( ErrStat2, ErrMsg2 ); if (Failed()) return + call AD_SetInputMotion( u(INPUT_PRED), & + HubPos_C, HubOri_C, HubVel_C, HubAcc_C, & + NacPos_C, NacOri_C, NacVel_C, NacAcc_C, & + BldRootPos_C, BldRootOri_C, BldRootVel_C, BldRootAcc_C, & + ErrStat2, ErrMsg2 ) ! transfer input motion mesh to u(1) meshes + if (Failed()) return + + + ! Set copy the current state over to the predicted state for sending to UpdateStates + ! -- The STATE_PREDicted will get updated in the call. + ! -- The UpdateStates routine expects this to contain states at T at the start of the call (history not passed in) + CALL ADI_CopyContState (x( STATE_CURR), x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + CALL ADI_CopyDiscState (xd( STATE_CURR), xd( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + CALL ADI_CopyConstrState (z( STATE_CURR), z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + CALL ADI_CopyOtherState (OtherStates(STATE_CURR), OtherStates(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + + + ! Call the main subroutine ADI_UpdateStates to get the velocities + CALL ADI_UpdateStates( InputTimes(INPUT_CURR), N_Global, u, InputTimes, p, x(STATE_PRED), xd(STATE_PRED), z(STATE_PRED), OtherStates(STATE_PRED), m, ErrStat2, ErrMsg2 ) + if (Failed()) return + + + !------------------------------------------------------- + ! cycle the states + !------------------------------------------------------- + ! move current state at T to previous state at T-dt + ! -- STATE_LAST now contains info at time T + ! -- this allows repeating the T --> T+dt update + CALL ADI_CopyContState (x( STATE_CURR), x( STATE_LAST), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + CALL ADI_CopyDiscState (xd( STATE_CURR), xd( STATE_LAST), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + CALL ADI_CopyConstrState (z( STATE_CURR), z( STATE_LAST), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + CALL ADI_CopyOtherState (OtherStates(STATE_CURR), OtherStates(STATE_LAST), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + ! Update the predicted state as the new current state + ! -- we have now advanced from T to T+dt. This allows calling with CalcOuput to get the outputs at T+dt + CALL ADI_CopyContState (x( STATE_PRED), x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + CALL ADI_CopyDiscState (xd( STATE_PRED), xd( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + CALL ADI_CopyConstrState (z( STATE_PRED), z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + CALL ADI_CopyOtherState (OtherStates(STATE_PRED), OtherStates(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + + + + call SetErr(ErrStat,ErrMsg,ErrStat_C,ErrMsg_C) + +contains + logical function Failed() + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Failed = ErrStat >= AbortErrLev + if (Failed) call SetErr(ErrStat,ErrMsg,ErrStat_C,ErrMsg_C) + end function Failed +END SUBROUTINE AeroDyn_Inflow_C_UpdateStates + +!=============================================================================================================== +!--------------------------------------------------- AeroDyn End----------------------------------------------- +!=============================================================================================================== +! NOTE: the error handling in this routine is slightly different than the other routines + +SUBROUTINE AeroDyn_Inflow_C_End(ErrStat_C,ErrMsg_C) BIND (C, NAME='AeroDyn_Inflow_C_End') + implicit none +#ifndef IMPLICIT_DLLEXPORT +!DEC$ ATTRIBUTES DLLEXPORT :: AeroDyn_Inflow_C_End +!GCC$ ATTRIBUTES DLLEXPORT :: AeroDyn_Inflow_C_End +#endif + integer(c_int), intent( out) :: ErrStat_C + character(kind=c_char), intent( out) :: ErrMsg_C(ErrMsgLen_C) + + ! Local variables + integer(IntKi) :: i !< generic loop counter + integer :: ErrStat !< aggregated error status + character(ErrMsgLen) :: ErrMsg !< aggregated error message + integer :: ErrStat2 !< temporary error status from a call + character(ErrMsgLen) :: ErrMsg2 !< temporary error message from a call + character(*), parameter :: RoutineName = 'AeroDyn_Inflow_C_End' !< for error handling + + ! Initialize error handling + ErrStat = ErrID_None + ErrMsg = "" + + ! clear out any globably allocated helper arrays + if (allocated(tmpBldPtMeshPos)) deallocate(tmpBldPtMeshPos) + if (allocated(tmpBldPtMeshOri)) deallocate(tmpBldPtMeshOri) + if (allocated(tmpBldPtMeshVel)) deallocate(tmpBldPtMeshVel) + if (allocated(tmpBldPtMeshAcc)) deallocate(tmpBldPtMeshAcc) + if (allocated(tmpBldPtMeshFrc)) deallocate(tmpBldPtMeshFrc) + + + ! Call the main subroutine ADI_End + ! If u is not allocated, then we didn't get far at all in initialization, + ! or AD_C_End got called before Init. We don't want a segfault, so check + ! for allocation. + if (allocated(u)) then + call ADI_End( u(:), p, x(STATE_CURR), xd(STATE_CURR), z(STATE_CURR), OtherStates(STATE_CURR), y, m, ErrStat2, ErrMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + endif + + ! NOTE: ADI_End only takes 1 instance of u, not the array. So extra + ! logic is required here (this isn't necessary in the fortran driver + ! or in openfast, but may be when this code is called from C, Python, + ! or some other code using the c-bindings. + if (allocated(u)) then + do i=2,size(u) + call ADI_DestroyInput( u(i), ErrStat2, ErrMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + enddo + if (allocated(u)) deallocate(u) + endif + + ! Destroy any other copies of states (rerun on (STATE_CURR) is ok) + call ADI_DestroyContState( x( STATE_LAST), ErrStat2, ErrMsg2 ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + call ADI_DestroyContState( x( STATE_CURR), ErrStat2, ErrMsg2 ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + call ADI_DestroyContState( x( STATE_PRED), ErrStat2, ErrMsg2 ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + call ADI_DestroyDiscState( xd( STATE_LAST), ErrStat2, ErrMsg2 ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + call ADI_DestroyDiscState( xd( STATE_CURR), ErrStat2, ErrMsg2 ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + call ADI_DestroyDiscState( xd( STATE_PRED), ErrStat2, ErrMsg2 ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + call ADI_DestroyConstrState( z( STATE_LAST), ErrStat2, ErrMsg2 ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + call ADI_DestroyConstrState( z( STATE_CURR), ErrStat2, ErrMsg2 ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + call ADI_DestroyConstrState( z( STATE_PRED), ErrStat2, ErrMsg2 ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + call ADI_DestroyOtherState( OtherStates(STATE_LAST), ErrStat2, ErrMsg2 ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + call ADI_DestroyOtherState( OtherStates(STATE_CURR), ErrStat2, ErrMsg2 ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + call ADI_DestroyOtherState( OtherStates(STATE_PRED), ErrStat2, ErrMsg2 ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ! if deallocate other items now + if (allocated(InputTimes)) deallocate(InputTimes) + + ! Clear out mesh related data storage + call ClearMesh() + + call SetErr(ErrStat,ErrMsg,ErrStat_C,ErrMsg_C) +CONTAINS + !> Don't leave junk in memory. So destroy meshes and mappings. + subroutine ClearMesh() + ! Blade + call MeshDestroy( BldPtMotionMesh, ErrStat2, ErrMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + call MeshDestroy( BldPtLoadMesh, ErrStat2, ErrMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! Destroy mesh mappings + if (allocated(Map_BldPtMotion_2_AD_Blade)) then + do i=1,NumBlades + call NWTC_Library_Destroymeshmaptype( Map_BldPtMotion_2_AD_Blade(i), ErrStat2, ErrMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + enddo + deallocate(Map_BldPtMotion_2_AD_Blade) + endif + if (allocated(Map_AD_BldLoad_P_2_BldPtLoad)) then + do i=1,NumBlades + call NWTC_Library_Destroymeshmaptype( Map_AD_BldLoad_P_2_BldPtLoad(i), ErrStat2, ErrMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + enddo + deallocate(Map_AD_BldLoad_P_2_BldPtLoad) + endif + ! Nacelle -- TODO: add this mesh for nacelle load transfers +! call MeshDestroy( NacMotionMesh, ErrStat2, ErrMsg2 ) +! call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) +! call MeshDestroy( NacLoadMesh, ErrStat2, ErrMsg2 ) +! call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) +! call NWTC_Library_Destroymeshmaptype( Map_AD_Nac_2_NacPtLoad , ErrStat2, ErrMsg2 ) +! call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) +! call NWTC_Library_Destroymeshmaptype( Map_NacPtMotion_2_AD_Nac , ErrStat2, ErrMsg2 ) +! call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + end subroutine ClearMesh +END SUBROUTINE AeroDyn_Inflow_C_End + + +!> This routine is operating on module level data. Error handling here in case checks added +subroutine Set_MotionMesh(ErrStat3, ErrMsg3) + integer(IntKi), intent( out) :: ErrStat3 + character(ErrMsgLen), intent( out) :: ErrMsg3 + integer(IntKi) :: iNode + ErrStat3 = 0_IntKi + ErrMsg3 = '' + ! Set mesh corresponding to input motions + do iNode=1,NumMeshPts + BldPtMotionMesh%TranslationDisp(1:3,iNode) = tmpBldPtMeshPos(1:3,iNode) - real(BldPtMotionMesh%Position(1:3,iNode), R8Ki) + BldPtMotionMesh%Orientation(1:3,1:3,iNode) = tmpBldPtMeshOri(1:3,1:3,iNode) + BldPtMotionMesh%TranslationVel( 1:3,iNode) = tmpBldPtMeshVel(1:3,iNode) + BldPtMotionMesh%RotationVel( 1:3,iNode) = tmpBldPtMeshVel(4:6,iNode) + BldPtMotionMesh%TranslationAcc( 1:3,iNode) = tmpBldPtMeshAcc(1:3,iNode) + !BldPtMotionMesh%RotationAcc( 1:3,iNode) = tmpBldPtMeshAcc(4:6,iNode) ! Rotational acc not included + call OrientRemap(BldPtMotionMesh%Orientation(1:3,1:3,iNode)) + if (TransposeDCM) then + BldPtMotionMesh%Orientation(1:3,1:3,iNode) = transpose(BldPtMotionMesh%Orientation(1:3,1:3,iNode)) + endif + enddo +end subroutine Set_MotionMesh + +!> Map the motion of the intermediate input mesh over to the input meshes +!! This routine is operating on module level data, hence few inputs +subroutine AD_SetInputMotion( u_local, & + HubPos_C, HubOri_C, HubVel_C, HubAcc_C, & + NacPos_C, NacOri_C, NacVel_C, NacAcc_C, & + BldRootPos_C, BldRootOri_C, BldRootVel_C, BldRootAcc_C, & + ErrStat, ErrMsg ) + type(ADI_InputType), intent(inout) :: u_local ! Only one input (probably at T) + real(c_float), intent(in ) :: HubPos_C( 3 ) !< Hub position + real(c_double), intent(in ) :: HubOri_C( 9 ) !< Hub orientation + real(c_float), intent(in ) :: HubVel_C( 6 ) !< Hub velocity + real(c_float), intent(in ) :: HubAcc_C( 6 ) !< Hub acceleration + real(c_float), intent(in ) :: NacPos_C( 3 ) !< Nacelle position + real(c_double), intent(in ) :: NacOri_C( 9 ) !< Nacelle orientation + real(c_float), intent(in ) :: NacVel_C( 6 ) !< Nacelle velocity + real(c_float), intent(in ) :: NacAcc_C( 6 ) !< Nacelle acceleration + real(c_float), intent(in ) :: BldRootPos_C( 3*NumBlades ) !< Blade root positions + real(c_double), intent(in ) :: BldRootOri_C( 9*NumBlades ) !< Blade root orientations + real(c_float), intent(in ) :: BldRootVel_C( 6*NumBlades ) !< Blade root velocities + real(c_float), intent(in ) :: BldRootAcc_C( 6*NumBlades ) !< Blade root accelerations + integer(IntKi), intent( out) :: ErrStat + character(ErrMsgLen), intent( out) :: ErrMsg + integer(IntKi) :: i + ErrStat = 0_IntKi + ErrMsg = '' + ! Hub -- NOTE: RotationalAcc not present in the mesh + if ( u_local%AD%rotors(1)%HubMotion%Committed ) then + u_local%AD%rotors(1)%HubMotion%TranslationDisp(1:3,1) = real(HubPos_C(1:3),R8Ki) - real(u_local%AD%rotors(1)%HubMotion%Position(1:3,1), R8Ki) + u_local%AD%rotors(1)%HubMotion%Orientation(1:3,1:3,1) = reshape( real(HubOri_C(1:9),R8Ki), (/3,3/) ) + u_local%AD%rotors(1)%HubMotion%TranslationVel(1:3,1) = real(HubVel_C(1:3), ReKi) + u_local%AD%rotors(1)%HubMotion%RotationVel(1:3,1) = real(HubVel_C(4:6), ReKi) + u_local%AD%rotors(1)%HubMotion%TranslationAcc(1:3,1) = real(HubAcc_C(1:3), ReKi) + call OrientRemap(u_local%AD%rotors(1)%HubMotion%Orientation(1:3,1:3,1)) + if (TransposeDCM) then + u_local%AD%rotors(1)%HubMotion%Orientation(1:3,1:3,1) = transpose(u_local%AD%rotors(1)%HubMotion%Orientation(1:3,1:3,1)) + endif + endif + ! Nacelle -- NOTE: RotationalVel and RotationalAcc not present in the mesh + if ( u_local%AD%rotors(1)%NacelleMotion%Committed ) then + u_local%AD%rotors(1)%NacelleMotion%TranslationDisp(1:3,1) = real(NacPos_C(1:3),R8Ki) - real(u_local%AD%rotors(1)%NacelleMotion%Position(1:3,1), R8Ki) + u_local%AD%rotors(1)%NacelleMotion%Orientation(1:3,1:3,1) = reshape( real(NacOri_C(1:9),R8Ki), (/3,3/) ) + u_local%AD%rotors(1)%NacelleMotion%TranslationVel(1:3,1) = real(NacVel_C(1:3), ReKi) + u_local%AD%rotors(1)%NacelleMotion%TranslationAcc(1:3,1) = real(NacAcc_C(1:3), ReKi) + call OrientRemap(u_local%AD%rotors(1)%NacelleMotion%Orientation(1:3,1:3,1)) + if (TransposeDCM) then + u_local%AD%rotors(1)%NacelleMotion%Orientation(1:3,1:3,1) = transpose(u_local%AD%rotors(1)%NacelleMotion%Orientation(1:3,1:3,1)) + endif + endif + ! Blade root + do i=0,numBlades-1 + if ( u_local%AD%rotors(1)%BladeRootMotion(i+1)%Committed ) then + u_local%AD%rotors(1)%BladeRootMotion(i+1)%TranslationDisp(1:3,1) = real(BldRootPos_C(3*i+1:3*i+3),R8Ki) - real(u_local%AD%rotors(1)%BladeRootMotion(i+1)%Position(1:3,1), R8Ki) + u_local%AD%rotors(1)%BladeRootMotion(i+1)%Orientation(1:3,1:3,1) = reshape( real(BldRootOri_C(9*i+1:9*i+9),R8Ki), (/3,3/) ) + u_local%AD%rotors(1)%BladeRootMotion(i+1)%TranslationVel(1:3,1) = real(BldRootVel_C(6*i+1:6*i+3), ReKi) + u_local%AD%rotors(1)%BladeRootMotion(i+1)%RotationVel(1:3,1) = real(BldRootVel_C(6*i+4:6*i+6), ReKi) + u_local%AD%rotors(1)%BladeRootMotion(i+1)%TranslationAcc(1:3,1) = real(BldRootAcc_C(6*i+1:6*i+3), ReKi) + u_local%AD%rotors(1)%BladeRootMotion(i+1)%RotationAcc(1:3,1) = real(BldRootAcc_C(6*i+4:6*i+6), ReKi) + call OrientRemap(u_local%AD%rotors(1)%BladeRootMotion(i+1)%Orientation(1:3,1:3,1)) + if (TransposeDCM) then + u_local%AD%rotors(1)%BladeRootMotion(i+1)%Orientation(1:3,1:3,1) = transpose(u_local%AD%rotors(1)%BladeRootMotion(i+1)%Orientation(1:3,1:3,1)) + endif + endif + enddo + + ! Blade mesh + do i=1,numBlades + if ( u_local%AD%rotors(1)%BladeMotion(i)%Committed ) then + call Transfer_Point_to_Line2( BldPtMotionMesh, u_local%AD%rotors(1)%BladeMotion(i), Map_BldPtMotion_2_AD_Blade(i), ErrStat, ErrMsg ) + if (ErrStat >= AbortErrLev) return + endif + enddo +end subroutine AD_SetInputMotion + +!> Map the loads of the output mesh to the intermediate output mesh. +!! This routine is operating on module level data, hence few inputs +subroutine AD_TransferLoads( u_local, y_local, ErrStat3, ErrMsg3 ) + type(ADI_InputType), intent(in ) :: u_local ! Only one input (probably at T) + type(ADI_OutputType), intent(in ) :: y_local ! Only one input (probably at T) + integer(IntKi), intent( out) :: ErrStat3 + character(ErrMsgLen), intent( out) :: ErrMsg3 + integer(IntKi) :: i + BldPtLoadMesh%Force = 0.0_ReKi + BldPtLoadMesh%Moment = 0.0_ReKi + do i=1,NumBlades + if ( y_local%AD%rotors(1)%BladeLoad(i)%Committed ) then + if (debugverbose > 4) call MeshPrintInfo( CU, y_local%AD%rotors(1)%BladeLoad(i), MeshName='AD%rotors('//trim(Num2LStr(1))//')%BladeLoad('//trim(Num2LStr(i))//')' ) + call Transfer_Line2_to_Point( y%AD%rotors(1)%BladeLoad(i), BldPtLoadMesh_tmp, Map_AD_BldLoad_P_2_BldPtLoad(i), & + ErrStat3, ErrMsg3, u_local%AD%rotors(1)%BladeMotion(i), BldPtMotionMesh ) + if (ErrStat3 >= AbortErrLev) return + BldPtLoadMesh%Force = BldPtLoadMesh%Force + BldPtLoadMesh_tmp%Force + BldPtLoadMesh%Moment = BldPtLoadMesh%Moment + BldPtLoadMesh_tmp%Moment + endif + enddo + if (debugverbose > 4) call MeshPrintInfo( CU, BldPtLoadMesh, MeshName='BldPtLoadMesh' ) +end subroutine AD_TransferLoads + +!> Transfer the loads from the load mesh to the temporary array for output +!! This routine is operating on module level data, hence few inputs +subroutine Set_OutputLoadArray() + integer(IntKi) :: iNode + ! Set mesh corresponding to input motions + do iNode=1,NumMeshPts + tmpBldPtMeshFrc(1:3,iNode) = BldPtLoadMesh%Force (1:3,iNode) + tmpBldPtMeshFrc(4:6,iNode) = BldPtLoadMesh%Moment(1:3,iNode) + enddo +end subroutine Set_OutputLoadArray + +!> take DCM passed in, do Euler angle extract, then Euler angle construct back to DCM. Idea here is we can account +!! for minor accuracy issues in the passed DCM +subroutine OrientRemap(DCM) + real(R8Ki), intent(inout) :: DCM(3,3) + real(R8Ki) :: theta(3) +! real(R8Ki) :: logMap(3) +! integer(IntKi) :: TmpErrStat ! DCM_logMapD requires this output, but doesn't use it at all +! character(ErrMsgLen) :: TmpErrMsg ! DCM_logMapD requires this output, but doesn't use it at all +!write(200,*) reshape(DCM,(/9/)) + theta = EulerExtract(DCM) + DCM = EulerConstruct(theta) +! call DCM_logMap(DCM,logMap,TmpErrStat,TmpErrMsg) +! DCM = DCM_Exp(logMap) +!write(201,*) reshape(DCM,(/9/)) +end subroutine OrientRemap + + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This subroutine sets up the information needed for plotting VTK surfaces. +!! NOTE: this is a duplicate of some pieces in the AeroDyn_Driver_Subs. This should +!! eventually be combined into ADI +subroutine SetVTKParameters(OutRootName, rot_u, RefPoint, errStat, errMsg) + character(IntfStrLen), intent(in ) :: OutRootName !< Root name to use for echo files and other + type(RotInputType), intent(in ) :: rot_u(:) + real(SiKi), intent(in ) :: RefPoint(3) + integer(IntKi), intent( out) :: errStat !< Error status of the operation + character(*), intent( out) :: errMsg !< Error message if errStat /= ErrID_None + real(SiKi) :: RefLengths(2) + real(SiKi) :: TwrLength + integer(IntKi) :: iBld, nNodes + integer(IntKi) :: iWT + character(IntfStrLen) :: TmpFileName + integer(IntKi) :: errStat2 + character(ErrMsgLen) :: errMsg2 + character(*), parameter :: RoutineName = 'SetVTKParameters' + real(SiKi) :: BladeLength, MaxBladeLength, MaxTwrLength, GroundRad, MaxLength + real(SiKi) :: WorldBoxMax(3), WorldBoxMin(3) ! Extent of the turbines + real(SiKi) :: BaseBoxDim + errStat = ErrID_None + errMsg = "" + + ! get the name of the output directory for vtk files (in a subdirectory called "vtk" of the output directory), and + ! create the VTK directory if it does not exist + call GetPath ( OutRootName, VTK_OutFileRoot, TmpFileName ) ! the returned VTK_OutFileRoot includes a file separator character at the end + VTK_OutFileRoot = trim(VTK_OutFileRoot) // 'vtk-ADI' + call MKDIR( trim(VTK_OutFileRoot) ) + VTK_OutFileRoot = trim( VTK_OutFileRoot ) // PathSep // trim(TmpFileName) + + ! calculate the number of digits in 'y_FAST%NOutSteps' (Maximum number of output steps to be written) + ! this will be used to pad the write-out step in the VTK filename with zeros in calls to MeshWrVTK() + VTK_tWidth = CEILING( log10( TMax / dT_Global ) ) + 1 + + if (allocated(VTK_Surface)) then + return ! The surfaces were already computed (for combined cases) + endif + + allocate(VTK_Surface(NumTurbines)) + ! --- Find dimensions for all objects to determine "Ground" and typical dimensions + MaxBladeLength = 0 + MaxTwrLength = 0 + MaxLength = 0 + do iWT=1,numTurbines + do iBld=1, NumBlades + nNodes = rot_u(iWT)%BladeMotion(iBld)%nnodes + BladeLength = TwoNorm(rot_u(iWT)%BladeMotion(iBld)%Position(:,nNodes)-rot_u(iWT)%BladeMotion(iBld)%Position(:,1)) + MaxBladeLength = max(MaxBladeLength, BladeLength) + enddo + if (rot_u(iWt)%TowerMotion%Committed) then + if (rot_u(iWt)%TowerMotion%NNodes>0) then + TwrLength = TwoNorm( rot_u(iWt)%TowerMotion%position(:,1) - rot_u(iWt)%TowerMotion%position(:,rot_u(iWt)%TowerMotion%NNodes) ) + MaxTwrLength = max(MaxTwrLength, TwrLength) + endif + endif + MaxLength = max(MaxLength, MaxTwrLength, MaxBladeLength) + + ! Determine extent of the objects + if (iWT==1) then + WorldBoxMax(1) = RefPoint(1)+MaxLength + WorldBoxMax(2) = RefPoint(2)+MaxLength + WorldBoxMax(3) = RefPoint(3)+MaxLength ! NOTE: not used + WorldBoxMin(1) = RefPoint(1)-MaxLength + WorldBoxMin(2) = RefPoint(2)-MaxLength + WorldBoxMin(3) = RefPoint(3)-MaxLength ! NOTE: not used + else + WorldBoxMax(1) = max(WorldBoxMax(1), RefPoint(1)+MaxLength) + WorldBoxMax(2) = max(WorldBoxMax(2), RefPoint(2)+MaxLength) + WorldBoxMax(3) = max(WorldBoxMax(3), RefPoint(3)+MaxLength) ! NOTE: not used + WorldBoxMin(1) = min(WorldBoxMin(1), RefPoint(1)-MaxLength) + WorldBoxMin(2) = min(WorldBoxMin(2), RefPoint(2)-MaxLength) + WorldBoxMin(3) = min(WorldBoxMin(3), RefPoint(3)-MaxLength) ! NOTE: not used + endif + enddo ! Loop on turbine + + ! Get radius for ground (blade length + hub radius): + GroundRad = MaxBladeLength + MaxTwrLength+ VTKHubRad + ! write the ground or seabed reference polygon: + ! Averaging the center point of the ground: + !RefPoint(1:2) = dvr%WT(1)%originInit(1:2) + !do iWT=2,NumTurbines + ! RefPoint(1:2) = RefPoint(1:2) + dvr%WT(iWT)%originInit(1:2) + !end do + !RefPoint(1:2) = RefPoint(1:2) / NumTurbines + + RefLengths = GroundRad + sqrt((WorldBoxMax(1)-WorldBoxMin(1))**2 + (WorldBoxMax(2)-WorldBoxMin(2))**2) + call WrVTK_Ground (RefPoint, RefLengths, trim(VTK_OutFileRoot) // '.GroundSurface', errStat2, errMsg2 ) + + + ! --- Create surfaces for Nacelle, Base, Tower, Blades + do iWT=1,NumTurbines + VTK_Surface(iWT)%NumSectors = 25 + + ! Create nacelle box + VTK_Surface(iWT)%NacelleBox(:,1) = (/ VTKNacDim(1) , VTKNacDim(2)+VTKNacDim(5), VTKNacDim(3) /) + VTK_Surface(iWT)%NacelleBox(:,2) = (/ VTKNacDim(1)+VTKNacDim(4), VTKNacDim(2)+VTKNacDim(5), VTKNacDim(3) /) + VTK_Surface(iWT)%NacelleBox(:,3) = (/ VTKNacDim(1)+VTKNacDim(4), VTKNacDim(2) , VTKNacDim(3) /) + VTK_Surface(iWT)%NacelleBox(:,4) = (/ VTKNacDim(1) , VTKNacDim(2) , VTKNacDim(3) /) + VTK_Surface(iWT)%NacelleBox(:,5) = (/ VTKNacDim(1) , VTKNacDim(2) , VTKNacDim(3)+VTKNacDim(6) /) + VTK_Surface(iWT)%NacelleBox(:,6) = (/ VTKNacDim(1)+VTKNacDim(4), VTKNacDim(2) , VTKNacDim(3)+VTKNacDim(6) /) + VTK_Surface(iWT)%NacelleBox(:,7) = (/ VTKNacDim(1)+VTKNacDim(4), VTKNacDim(2)+VTKNacDim(5), VTKNacDim(3)+VTKNacDim(6) /) + VTK_Surface(iWT)%NacelleBox(:,8) = (/ VTKNacDim(1) , VTKNacDim(2)+VTKNacDim(5), VTKNacDim(3)+VTKNacDim(6) /) + + ! Create base box (using towerbase or nacelle dim) + BaseBoxDim = minval(VTKNacDim(4:6))/2 + if (size(m%VTK_Surfaces(iWT)%TowerRad)>0) then + BaseBoxDim = m%VTK_Surfaces(iWT)%TowerRad(1) + endif + VTK_Surface(iWT)%BaseBox(:,1) = (/ -BaseBoxDim , -BaseBoxDim+2*BaseBoxDim, -BaseBoxDim /) + VTK_Surface(iWT)%BaseBox(:,2) = (/ -BaseBoxDim+2*BaseBoxDim, -BaseBoxDim+2*BaseBoxDim, -BaseBoxDim /) + VTK_Surface(iWT)%BaseBox(:,3) = (/ -BaseBoxDim+2*BaseBoxDim, -BaseBoxDim , -BaseBoxDim /) + VTK_Surface(iWT)%BaseBox(:,4) = (/ -BaseBoxDim , -BaseBoxDim , -BaseBoxDim /) + VTK_Surface(iWT)%BaseBox(:,5) = (/ -BaseBoxDim , -BaseBoxDim , -BaseBoxDim+2*BaseBoxDim /) + VTK_Surface(iWT)%BaseBox(:,6) = (/ -BaseBoxDim+2*BaseBoxDim, -BaseBoxDim , -BaseBoxDim+2*BaseBoxDim /) + VTK_Surface(iWT)%BaseBox(:,7) = (/ -BaseBoxDim+2*BaseBoxDim, -BaseBoxDim+2*BaseBoxDim, -BaseBoxDim+2*BaseBoxDim /) + VTK_Surface(iWT)%BaseBox(:,8) = (/ -BaseBoxDim , -BaseBoxDim+2*BaseBoxDim, -BaseBoxDim+2*BaseBoxDim /) + + enddo ! iWT, turbines +end subroutine SetVTKParameters + +!> Write VTK reference meshes and setup directory if needed. +!! NOTE: it is assumed that only an fatal error will be returned in the subroutines contained here +subroutine WrVTK_refMeshes(rot_u, RefPoint, ErrStat, ErrMsg) + type(RotInputType), intent(in ) :: rot_u(:) !< pointer to rotor input (for easier to read code) + real(SiKi), intent(in ) :: RefPoint(3) + integer(IntKi), intent( out) :: ErrStat !< error status + character(ErrMsgLen), intent( out) :: ErrMsg !< error message + integer(IntKi) :: nBlades + integer(IntKi) :: iWT, k + character(*), parameter :: RoutineName = 'WrVTK_refMeshes' !< for error handling + integer(IntKi) :: ErrStat2 !< temporary error status + character(ErrMsgLen) :: ErrMsg2 !< temporary error message + character(10) :: sWT + + ErrStat = 0_IntKi + ErrMsg = '' + + iWT = 1 !TODO: expand for multiple turbines + + ! Turbine identifier + if (NumTurbines==1) then + sWT = '' + else + sWT = '.T'//trim(num2lstr(iWT)) + endif + + select case (WrVTK_Type) + case (1) ! surfaces -- don't write any surface references + call WrVTK_PointsRef( ErrStat2,ErrMsg2); if (Failed()) return; + case (2) ! lines + call WrVTK_PointsRef( ErrStat2,ErrMsg2); if (Failed()) return; + call WrVTK_LinesRef( ErrStat2,ErrMsg2); if (Failed()) return; + case (3) ! both + call WrVTK_PointsRef( ErrStat2,ErrMsg2); if (Failed()) return; + call WrVTK_LinesRef( ErrStat2,ErrMsg2); if (Failed()) return; + end select + +contains + logical function Failed() + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Failed = ErrStat >= AbortErrLev + end function Failed + + !> meshes rendered at all times (points, or lines for fvw) + subroutine WrVTK_PointsRef(ErrStat3,ErrMsg3) + integer(IntKi), intent( out) :: ErrStat3 !< error status + character(ErrMsgLen), intent( out) :: ErrMsg3 !< error message + ErrStat3 = 0_IntKi + ErrMsg3 = '' + + ! Blade point motion (structural mesh from driver) + call MeshWrVTKreference(RefPoint, BldPtMotionMesh, trim(VTK_OutFileRoot)//trim(sWT)//'.BldPtMotionMesh', ErrStat3, ErrMsg3) + if (ErrStat3 >= AbortErrLev) return + + ! Blade root motion (point only) + if (allocated(rot_u(iWT)%BladeRootMotion)) then + do k=1,NumBlades + if (rot_u(iWT)%BladeRootMotion(k)%Committed) then + call MeshWrVTKreference(RefPoint, rot_u(iWT)%BladeRootMotion(k), trim(VTK_OutFileRoot)//trim(sWT)//'.BladeRootMotion'//trim(num2lstr(k)), ErrStat3, ErrMsg3 ) + if (ErrStat3 >= AbortErrLev) return + endif + enddo + endif + + ! Nacelle (structural point input + if ( rot_u(iWT)%NacelleMotion%Committed ) call MeshWrVTKreference(RefPoint, rot_u(iWT)%NacelleMotion, trim(VTK_OutFileRoot)//trim(sWT)//'.NacelleMotion', ErrStat3, ErrMsg3) + if (ErrStat3 >= AbortErrLev) return + end subroutine WrVTK_PointsRef + + !> meshes rendered with lines only + subroutine WrVTK_LinesRef(ErrStat3,ErrMsg3) + integer(IntKi), intent( out) :: ErrStat3 !< error status + character(ErrMsgLen), intent( out) :: ErrMsg3 !< error message + ErrStat3 = 0_IntKi + ErrMsg3 = '' + + ! Tower + if (rot_u(iWT)%TowerMotion%Committed) call MeshWrVTKreference(RefPoint, rot_u(iWT)%TowerMotion, trim(VTK_OutFileRoot)//trim(sWT)//'.Tower', ErrStat3, ErrMsg3 ) + if (ErrStat3 >= AbortErrLev) return + + ! Nacelle meshes + if (rot_u(iWT)%NacelleMotion%Committed) call MeshWrVTKreference(RefPoint, rot_u(iWT)%NacelleMotion, trim(VTK_OutFileRoot)//trim(sWT)//'.Nacelle', ErrStat3, ErrMsg3 ) + if (ErrStat3 >= AbortErrLev) return + + ! Hub + if (rot_u(iWT)%HubMotion%Committed) call MeshWrVTKreference(RefPoint, rot_u(iWT)%HubMotion, trim(VTK_OutFileRoot)//trim(sWT)//'.Hub', ErrStat3, ErrMsg3 ) + if (ErrStat3 >= AbortErrLev) return + + ! Blades + if (allocated(rot_u(iWT)%BladeMotion)) then + do k=1,NumBlades + if (rot_u(iWT)%BladeMotion(k)%Committed) then + call MeshWrVTKreference(RefPoint, rot_u(iWT)%BladeMotion(k), trim(VTK_OutFileRoot)//trim(sWT)//'.Blade'//trim(num2lstr(k)), ErrStat3, ErrMsg3 ) + if (ErrStat3 >= AbortErrLev) return + endif + enddo + endif + end subroutine WrVTK_LinesRef +end subroutine WrVTK_refMeshes + +!> Write VTK meshes +!! NOTE: it is assumed that only an fatal error will be returned in the subroutines contained here +subroutine WrVTK_Meshes(rot_u, RefPoint, ErrStat, ErrMsg) + type(RotInputType), intent(in ) :: rot_u(:) !< pointer to rotor input (for easier to read code) + real(SiKi), intent(in ) :: RefPoint(3) !< turbine reference point + integer(IntKi), intent( out) :: ErrStat !< error status + character(ErrMsgLen), intent( out) :: ErrMsg !< error message + integer(IntKi) :: nBlades + integer(IntKi) :: iWT, k + character(IntfStrLen) :: TmpFileName + character(*), parameter :: RoutineName = 'WrVTK_Meshes' !< for error handling + integer(IntKi) :: ErrStat2 !< temporary error status + character(ErrMsgLen) :: ErrMsg2 !< temporary error message + character(10) :: sWT + + ErrStat = 0_IntKi + ErrMsg = '' + + iWT = 1 !TODO: expand for multiple turbines + + ! Turbine identifier + if (NumTurbines==1) then + sWT = '' + else + sWT = '.T'//trim(num2lstr(iWT)) + endif + + + select case (WrVTK_Type) + case (1) ! surfaces + call WrVTK_Points( ErrStat2,ErrMsg2); if (Failed()) return; + call WrVTK_Surfaces(ErrStat2,ErrMsg2); if (Failed()) return; + case (2) ! lines + call WrVTK_Points( ErrStat2,ErrMsg2); if (Failed()) return; + call WrVTK_Lines( ErrStat2,ErrMsg2); if (Failed()) return; + case (3) ! both + call WrVTK_Points( ErrStat2,ErrMsg2); if (Failed()) return; + call WrVTK_Surfaces(ErrStat2,ErrMsg2); if (Failed()) return; + call WrVTK_Lines( ErrStat2,ErrMsg2); if (Failed()) return; + end select + +contains + logical function Failed() + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Failed = ErrStat >= AbortErrLev + end function Failed + + !> meshes rendered at all times (points, or lines for fvw) + subroutine WrVTK_Points(ErrStat3,ErrMsg3) + use FVW_IO, only: WrVTK_FVW + integer(IntKi), intent( out) :: ErrStat3 !< error status + character(ErrMsgLen), intent( out) :: ErrMsg3 !< error message + ErrStat3 = 0_IntKi + ErrMsg3 = '' + + ! Blade point motion (structural mesh from driver) + call MeshWrVTK(RefPoint, BldPtMotionMesh, trim(VTK_OutFileRoot)//trim(sWT)//'.BldPtMotionMesh', N_Global, .true., ErrStat3, ErrMsg3, VTK_tWidth) + if (ErrStat3 >= AbortErrLev) return + + ! Blade root motion (point only) + if (allocated(rot_u(iWT)%BladeRootMotion)) then + do k=1,NumBlades + if (rot_u(iWT)%BladeRootMotion(k)%Committed) then + call MeshWrVTK(RefPoint, rot_u(iWT)%BladeRootMotion(k), trim(VTK_OutFileRoot)//trim(sWT)//'.BladeRootMotion'//trim(num2lstr(k)), N_Global, .true., ErrStat3, ErrMsg3, VTK_tWidth) + if (ErrStat3 >= AbortErrLev) return + endif + enddo + endif + + ! Nacelle (structural point input + if ( rot_u(iWT)%NacelleMotion%Committed ) call MeshWrVTK(RefPoint, rot_u(iWT)%NacelleMotion, trim(VTK_OutFileRoot)//trim(sWT)//'.NacelleMotion', N_Global, .true., ErrStat3, ErrMsg3, VTK_tWidth) + if (ErrStat3 >= AbortErrLev) return + + ! Free wake + if (allocated(m%AD%FVW_u) .and. iWT==1) then + if (allocated(m%AD%FVW_u(1)%WingsMesh)) then + call WrVTK_FVW(p%AD%FVW, x(STATE_CURR)%AD%FVW, z(STATE_CURR)%AD%FVW, m%AD%FVW, trim(VTK_OutFileRoot)//'.FVW', N_Global, VTK_tWidth, bladeFrame=.FALSE.) ! bladeFrame==.FALSE. to output in global coords + endif + end if + end subroutine WrVTK_Points + + !> meshes rendered with a shape or size + subroutine WrVTK_Surfaces(ErrStat3,ErrMsg3) + integer(IntKi), intent( out) :: ErrStat3 !< error status + character(ErrMsgLen), intent( out) :: ErrMsg3 !< error message + 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), parameter :: numSectors = 25 ! Number of sectors for surface utput + + ErrStat3 = 0_IntKi + ErrMsg3 = '' + +!TODO: use this routine when it is moved out of the driver and into ADI +! call AD_WrVTK_Surfaces(u(1)%AD, y%AD, RefPoint, m%VTK_Surfaces, N_Global, VTK_OutFileRoot, VTK_tWidth, 25, VTKHubRad) + + ! Nacelle + if ( rot_u(iWT)%NacelleMotion%Committed ) then + call MeshWrVTK_PointSurface (RefPoint, rot_u(iWT)%NacelleMotion, trim(VTK_OutFileRoot)//trim(sWT)//'.NacelleSurface', N_Global, & + OutputFields, errStat3, errMsg3, VTK_tWidth, verts=VTK_Surface(iWT)%NacelleBox) + if (ErrStat3 >= AbortErrLev) return + endif + + ! Tower + if (rot_u(iWT)%TowerMotion%Committed) then + call MeshWrVTK_Ln2Surface (RefPoint, rot_u(iWT)%TowerMotion, trim(VTK_OutFileRoot)//trim(sWT)//'.TowerSurface', & + N_Global, OutputFields, errStat3, errMsg3, VTK_tWidth, numSectors, m%VTK_Surfaces(iWT)%TowerRad ) + if (ErrStat3 >= AbortErrLev) return + endif + + ! Hub + if (rot_u(iWT)%HubMotion%Committed) then + call MeshWrVTK_PointSurface (RefPoint, rot_u(iWT)%HubMotion, trim(VTK_OutFileRoot)//trim(sWT)//'.HubSurface', & + N_Global, OutputFields, errStat3, errMsg3, VTK_tWidth, & + NumSegments=numSectors, radius=VTKHubRad) + if (ErrStat3 >= AbortErrLev) return + endif + + ! Blades + if (allocated(rot_u(iWT)%BladeMotion)) then + do k=1,NumBlades + if (rot_u(iWT)%BladeMotion(k)%Committed) then + call MeshWrVTK_Ln2Surface (RefPoint, rot_u(iWT)%BladeMotion(k), trim(VTK_OutFileRoot)//trim(sWT)//'.Blade'//trim(num2lstr(k))//'Surface', & + N_Global, OutputFields, errStat3, errMsg3, VTK_tWidth , verts=m%VTK_Surfaces(iWT)%BladeShape(k)%AirfoilCoords, & + Sib=y%AD%rotors(iWT)%BladeLoad(k) ) + if (ErrStat3 >= AbortErrLev) return + endif + enddo + endif + end subroutine WrVTK_Surfaces + + !> meshes rendered with lines only + subroutine WrVTK_Lines(ErrStat3,ErrMsg3) + integer(IntKi), intent( out) :: ErrStat3 !< error status + character(ErrMsgLen), intent( out) :: ErrMsg3 !< error message + ErrStat3 = 0_IntKi + ErrMsg3 = '' + + ! Tower + if (rot_u(iWT)%TowerMotion%Committed) call MeshWrVTK(RefPoint, rot_u(iWT)%TowerMotion, trim(VTK_OutFileRoot)//trim(sWT)//'.Tower', N_Global, .true., ErrStat3, ErrMsg3, VTK_tWidth) + if (ErrStat3 >= AbortErrLev) return + + ! Nacelle meshes + if (rot_u(iWT)%NacelleMotion%Committed) call MeshWrVTK(RefPoint, rot_u(iWT)%NacelleMotion, trim(VTK_OutFileRoot)//trim(sWT)//'.Nacelle', N_Global, .true., ErrStat3, ErrMsg3, VTK_tWidth) + if (ErrStat3 >= AbortErrLev) return + + ! Hub + if (rot_u(iWT)%HubMotion%Committed) call MeshWrVTK(RefPoint, rot_u(iWT)%HubMotion, trim(VTK_OutFileRoot)//trim(sWT)//'.Hub', N_Global, .true., ErrStat3, ErrMsg3, VTK_tWidth) + if (ErrStat3 >= AbortErrLev) return + + ! Blades + if (allocated(rot_u(iWT)%BladeMotion)) then + do k=1,NumBlades + if (rot_u(iWT)%BladeMotion(k)%Committed) then + call MeshWrVTK(RefPoint, rot_u(iWT)%BladeMotion(k), trim(VTK_OutFileRoot)//trim(sWT)//'.Blade'//trim(num2lstr(k)), N_Global, .true., ErrStat3, ErrMsg3, VTK_tWidth) + if (ErrStat3 >= AbortErrLev) return + endif + enddo + endif + end subroutine WrVTK_Lines +end subroutine WrVTK_Meshes + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine writes the ground or seabed reference surface information in VTK format. +!! see VTK file information format for XML, here: http://www.vtk.org/wp-content/uploads/2015/04/file-formats.pdf +!! TODO: this is a duplicate of the AeroDyn_Driver_Subs.f90 routine!!!! +subroutine WrVTK_Ground (RefPoint, HalfLengths, FileRootName, errStat, errMsg) + REAL(SiKi), INTENT(IN) :: RefPoint(3) !< reference point (plane will be created around it) + REAL(SiKi), INTENT(IN) :: HalfLengths(2) !< half of the X-Y lengths of plane surrounding RefPoint + CHARACTER(*), INTENT(IN) :: FileRootName !< Name of the file to write the output in (excluding extension) + INTEGER(IntKi), INTENT(OUT) :: errStat !< Indicates whether an error occurred (see NWTC_Library) + CHARACTER(*), INTENT(OUT) :: errMsg !< Error message associated with the errStat + ! local variables + INTEGER(IntKi) :: Un ! fortran unit number + INTEGER(IntKi) :: ix ! loop counters + CHARACTER(1024) :: FileName + INTEGER(IntKi), parameter :: NumberOfPoints = 4 + INTEGER(IntKi), parameter :: NumberOfLines = 0 + INTEGER(IntKi), parameter :: NumberOfPolys = 1 + INTEGER(IntKi) :: errStat2 + CHARACTER(ErrMsgLen) :: errMsg2 + errStat = ErrID_None + errMsg = "" + FileName = TRIM(FileRootName)//'.vtp' + call WrVTK_header( FileName, NumberOfPoints, NumberOfLines, NumberOfPolys, Un, errStat2, errMsg2 ) + call SetErrStat(errStat2,errMsg2,errStat,errMsg,'WrVTK_Ground'); if (errStat >= AbortErrLev) return + WRITE(Un,'(A)') ' ' + WRITE(Un,'(A)') ' ' + WRITE(Un,VTK_AryFmt) RefPoint(1) + HalfLengths(1) , RefPoint(2) + HalfLengths(2), RefPoint(3) + WRITE(Un,VTK_AryFmt) RefPoint(1) + HalfLengths(1) , RefPoint(2) - HalfLengths(2), RefPoint(3) + WRITE(Un,VTK_AryFmt) RefPoint(1) - HalfLengths(1) , RefPoint(2) - HalfLengths(2), RefPoint(3) + WRITE(Un,VTK_AryFmt) RefPoint(1) - HalfLengths(1) , RefPoint(2) + HalfLengths(2), RefPoint(3) + WRITE(Un,'(A)') ' ' + WRITE(Un,'(A)') ' ' + WRITE(Un,'(A)') ' ' + WRITE(Un,'(A)') ' ' + WRITE(Un,'('//trim(num2lstr(NumberOfPoints))//'(i7))') (ix, ix=0,NumberOfPoints-1) + WRITE(Un,'(A)') ' ' + + WRITE(Un,'(A)') ' ' + WRITE(Un,'(i7)') NumberOfPoints + WRITE(Un,'(A)') ' ' + WRITE(Un,'(A)') ' ' + call WrVTK_footer( Un ) +end subroutine WrVTK_Ground + + + +END MODULE AeroDyn_Inflow_C_BINDING diff --git a/modules/aerodyn/src/AeroDyn_Inflow_Registry.txt b/modules/aerodyn/src/AeroDyn_Inflow_Registry.txt new file mode 100644 index 0000000000..a64a4896b9 --- /dev/null +++ b/modules/aerodyn/src/AeroDyn_Inflow_Registry.txt @@ -0,0 +1,135 @@ +################################################################################################################################### +# Registry for AeroDyn with InflowWind +# This Registry file is used to create AeroDyn_Types which contains data used in the AeroDyn module. +# It also contains copy, destroy, pack, and unpack routines associated with each defined data types. +# See the NWTC Programmer's Handbook for further information on the format/contents of this file. +# +# Entries are of the form +# +# +# Use ^ as a shortcut for the value in the same column from the previous line. +################################################################################################################################### +# ...... Include files (definitions from NWTC Library) ............................................................................ +include Registry_NWTC_Library.txt +usefrom AeroDyn_Registry.txt +usefrom InflowWind.txt + +param AeroDyn_Inflow/ADI - IntKi ADI_Version - 1 - "" - + + +# ..... InflowWind data ..................................................................................................... +typedef ^ ADI_InflowWindData InflowWind_ContinuousStateType x - - - "Continuous states" +typedef ^ ^ InflowWind_DiscreteStateType xd - - - "Discrete states" +typedef ^ ^ InflowWind_ConstraintStateType z - - - "Constraint states" +typedef ^ ^ InflowWind_OtherStateType OtherSt - - - "Other states" +typedef ^ ^ InflowWind_ParameterType p - - - "Parameters" +typedef ^ ^ InflowWind_MiscVarType m - - - "Misc/optimization variables" +typedef ^ ^ InflowWind_InputType u - - - "Array of inputs associated with InputTimes" +typedef ^ ^ InflowWind_OutputType y - - - "System outputs" +typedef ^ ^ IntKi CompInflow - - - "0=Steady Wind, 1=InflowWind" "-" +typedef ^ ^ ReKi HWindSpeed - - - "RefHeight Wind speed" +typedef ^ ^ ReKi RefHt - - - "RefHeight" +typedef ^ ^ ReKi PLExp - - - "PLExp" +# ..... InflowWind Input data ..................................................................................................... +typedef ^ ADI_IW_InputData Character(1024) InputFile - - - "Name of InfloWind input file" - +typedef ^ ^ IntKi CompInflow - - - "0=Steady Wind, 1=InflowWind" "-" +typedef ^ ^ ReKi HWindSpeed - - - "RefHeight Wind speed" +typedef ^ ^ ReKi RefHt - - - "RefHeight" +typedef ^ ^ ReKi PLExp - - - "PLExp" +typedef ^ ^ LOGICAL UseInputFile - .TRUE. - "Should we read everthing from an input file, or is it passed in?" - +typedef ^ ^ FileInfoType PassedFileData - - - "If we don't use the input file, pass everything through this" - +typedef ^ ^ LOGICAL Linearize - .FALSE. - "Flag that tells this module if the glue code wants to linearize." - + + +# ..... InitIn .................................................................................................................... +typedef ^ InitInputType AD_InitInputType AD - - - "AD Init input types" +typedef ^ ^ ADI_IW_InputData IW_InitInp - - - "IW Init input types" +typedef ^ ^ Character(1024) RootName - - - "RootName for writing output files" - +typedef ^ ^ Logical storeHHVel - .false. - "If True, hub height velocity will be computed by infow wind" - +typedef ^ ^ IntKi WrVTK - 0 - "0= no vtk, 1=init only, 2=animation" "-" +typedef ^ ^ IntKi WrVTK_Type - 1 - "Flag for VTK output type (1=surface, 2=line, 3=both)" - + +# ..... InitOut ................................................................................................................... +typedef ^ InitOutputType ProgDesc Ver - - - "This module's name, version, and date" - +typedef ^ ^ character(ChanLen) WriteOutputHdr {:} - - "Channel headers" "-" +typedef ^ ^ character(ChanLen) WriteOutputUnt {:} - - "Channel units" "-" + +# ..... Continuous States ......................................................................................................... +typedef ^ ContinuousStateType AD_ContinuousStateType AD - - - "AD Continuous states" + +# ..... DiscreteStates ............................................................................................................ +typedef ^ DiscreteStateType AD_DiscreteStateType AD - - - "Discrete states" + +# ..... Constraints ............................................................................................................... +typedef ^ ConstraintStateType AD_ConstraintStateType AD - - - "Constraint states" + +# ..... OtherStates ............................................................................................................... +typedef ^ OtherStateType AD_OtherStateType AD - - - "Other states" + +# ..... Misc ...................................................................................................................... +typedef ^ MiscVarType AD_MiscVarType AD - - - "misc/optimization variables" +typedef ^ ^ ADI_InflowWindData IW - - - "All the necessary inflow wind data" +typedef ^ ^ AD_VTK_RotSurfaceType VTK_surfaces {:} - - "VTK outputs surfaces for each rotor" +# ..... Parameters ................................................................................................................ +typedef ^ ParameterType AD_ParameterType AD - - - "Parameters" +typedef ^ ^ DbKi dt - - - "time increment" "s" +typedef ^ ^ Logical storeHHVel - - - "If True, hub height velocity will be computed by infow wind" - +typedef ^ ^ IntKi wrVTK - - - "0= no vtk, 1=init only, 2=animation" "-" +typedef ^ ^ IntKi WrVTK_Type - - - "Flag for VTK output type (1=surface, 2=line, 3=both)" - +typedef ^ ^ IntKi NumOuts - 0 - "Total number of WriteOutput outputs" - + +# ..... Inputs .................................................................................................................... +typedef ^ InputType AD_InputType AD - - - "Array of system inputs" + +# ..... Outputs ................................................................................................................... +#typedef ^ ADI_RotOutputType ReKi WriteOutput {:} - - "WriteOutputs for a given rotor" - +typedef ^ OutputType AD_OutputType AD - - - "System outputs" +#typedef ^ ^ InflowWind_OutputType IW - - - "System outputs" +typedef ^ ^ ReKi HHVel {:}{:} - - "Hub Height velocities for each rotors" +typedef ^ ^ ReKi PLExp - - - "Power law exponents (for outputs only)" +typedef ^ ^ ReKi IW_WriteOutput {:} - - "WriteOutputs for inflow wind" - +#typedef ^ ^ ADI_RotOutputType rotors : - - "WriteOutputs of the driver only" +typedef ^ OutputType ReKi WriteOutput {:} - - "System outputs" + +# ..... AeroDyn_Inflow data ................................................................................................... +# NOTE: useful for driver/wrapper of this module +typedef ^ ADI_Data ADI_ContinuousStateType x - - - "Continuous states" +typedef ^ ^ ADI_DiscreteStateType xd - - - "Discrete states" +typedef ^ ^ ADI_ConstraintStateType z - - - "Constraint states" +typedef ^ ^ ADI_OtherStateType OtherState - - - "Other states" +typedef ^ ^ ADI_ParameterType p - - - "Parameters" +typedef ^ ^ ADI_MiscVarType m - - - "Misc/optimization variables" +typedef ^ ^ ADI_InputType u {2} - - "Array of inputs associated with InputTimes" +typedef ^ ^ ADI_OutputType y - - - "System outputs" +typedef ^ ^ DbKi inputTimes {2} - - "Array of times associated with u array" + +# ..... Rotor elastic data .................................................................................................. +# NOTE: useful for driver/wrapper of this module +typedef ^ RotFED MeshType PlatformPtMesh - - - "Platform reference point positions/orientations/velocities/accelerations" - +typedef ^ ^ MeshType TwrPtMesh - - - "(only if hasTower) Point mesh for tower base motion" "-" +typedef ^ ^ MeshType TwrPtMeshAD - - - "(only if hasTower) Point mesh for tower base for AD" "-" +#typedef ^ ^ MeshType TowerLn2Mesh - - - "Tower line2 mesh with positions/orientations/velocities/accelerations" - +typedef ^ ^ MeshType NacelleMotion - - - "Point mesh for nacelle point motion" "-" +typedef ^ ^ MeshType HubPtMotion - - - "Point mesh for hub point motion" "-" +typedef ^ ^ MeshType BladeRootMotion : - - "BladeRootMotion Point mesh for blade root motion" "-" +typedef ^ ^ MeshType BladeLn2Mesh : - - "(only if elastic blades) BladeLn2Mesh Line mesh along blade" "-" +typedef ^ ^ Logical hasTower - .true. - "True if a tower is present" "-" +typedef ^ ^ Logical rigidBlades - .true. - "True if blades are rigid (using BladeRootMotion) or not (Useing BldeLn2Mesh)" "-" +typedef ^ ^ IntKi numBlades - - - "Number of blades" - +typedef ^ ^ MeshMapType ED_P_2_AD_P_T - - - "(only if hasTower) Mesh mapping from tower base to AD tower base" +typedef ^ ^ MeshMapType AD_P_2_AD_L_T - - - "(only if hasTower) Mesh mapping from tower base to AD tower line" +typedef ^ ^ MeshMapType AD_P_2_AD_L_B : - - "(only for rigid blades) Mesh mapping from AD blade root to AD line mesh" "-" +typedef ^ ^ MeshMapType ED_P_2_AD_P_TF - - - "Map ElastoDyn TailFin CM point (taken as Nacelle) motion mesh to AeroDyn TailFin ref point motion mesh" +typedef ^ ^ MeshMapType ED_P_2_AD_P_R : - - "Map ElastoDyn BladeRootMotion point meshes to AeroDyn BladeRootMotion point meshes" +typedef ^ ^ MeshMapType ED_P_2_AD_P_H - - - "Map ElastoDyn HubPtMotion point mesh to AeroDyn HubMotion point mesh" +typedef ^ ^ MeshMapType ED_P_2_AD_P_N - - - "Map ElastoDyn Nacelle point motion mesh to AeroDyn Nacelle point motion mesh" +#typedef ^ ^ MeshMapType AD_P_2_ED_P_TF - - - "Map AeroDyn TailFin ref point load mesh to ElastoDyn TailFin CM point load mesh" +#typedef ^ ^ MeshMapType AD_P_2_ED_P_N - - - "Map AeroDyn Nacelle point load mesh to ElastoDyn nacelle point load mesh" +#typedef ^ ^ MeshMapType ED_L_2_AD_L_T - - - "Map ElastoDyn TowerLn2Mesh line2 mesh to AeroDyn14 Twr_InputMarkers or AeroDyn TowerMotion line2 mesh" +#typedef ^ ^ MeshMapType AD_L_2_ED_P_T - - - "Map AeroDyn14 Twr_InputMarkers or AeroDyn TowerLoad line2 mesh to ElastoDyn TowerPtLoads point mesh" + +# ..... Turbine elastic data ................................................................................................ +typedef ^ FED_Data RotFED WT : - - "Wind turbine/rotors elastic data" "-" + + + diff --git a/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 b/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 new file mode 100644 index 0000000000..4402859b0a --- /dev/null +++ b/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 @@ -0,0 +1,7367 @@ +!STARTOFREGISTRYGENERATEDFILE 'AeroDyn_Inflow_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 +!********************************************************************************************************************************* +! AeroDyn_Inflow_Types +!................................................................................................................................. +! This file is part of AeroDyn_Inflow. +! +! 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 AeroDyn_Inflow. 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 AeroDyn_Inflow_Types +!--------------------------------------------------------------------------------------------------------------------------------- +USE AeroDyn_Types +USE InflowWind_Types +USE NWTC_Library +IMPLICIT NONE + INTEGER(IntKi), PUBLIC, PARAMETER :: ADI_Version = 1 ! [-] +! ========= ADI_InflowWindData ======= + TYPE, PUBLIC :: ADI_InflowWindData + TYPE(InflowWind_ContinuousStateType) :: x !< Continuous states [-] + TYPE(InflowWind_DiscreteStateType) :: xd !< Discrete states [-] + TYPE(InflowWind_ConstraintStateType) :: z !< Constraint states [-] + TYPE(InflowWind_OtherStateType) :: OtherSt !< Other states [-] + TYPE(InflowWind_ParameterType) :: p !< Parameters [-] + TYPE(InflowWind_MiscVarType) :: m !< Misc/optimization variables [-] + TYPE(InflowWind_InputType) :: u !< Array of inputs associated with InputTimes [-] + TYPE(InflowWind_OutputType) :: y !< System outputs [-] + INTEGER(IntKi) :: CompInflow !< 0=Steady Wind, 1=InflowWind [-] + REAL(ReKi) :: HWindSpeed !< RefHeight Wind speed [-] + REAL(ReKi) :: RefHt !< RefHeight [-] + REAL(ReKi) :: PLExp !< PLExp [-] + END TYPE ADI_InflowWindData +! ======================= +! ========= ADI_IW_InputData ======= + TYPE, PUBLIC :: ADI_IW_InputData + Character(1024) :: InputFile !< Name of InfloWind input file [-] + INTEGER(IntKi) :: CompInflow !< 0=Steady Wind, 1=InflowWind [-] + REAL(ReKi) :: HWindSpeed !< RefHeight Wind speed [-] + REAL(ReKi) :: RefHt !< RefHeight [-] + REAL(ReKi) :: PLExp !< PLExp [-] + LOGICAL :: UseInputFile = .TRUE. !< Should we read everthing from an input file, or is it passed in? [-] + TYPE(FileInfoType) :: PassedFileData !< If we don't use the input file, pass everything through this [-] + LOGICAL :: Linearize = .FALSE. !< Flag that tells this module if the glue code wants to linearize. [-] + END TYPE ADI_IW_InputData +! ======================= +! ========= ADI_InitInputType ======= + TYPE, PUBLIC :: ADI_InitInputType + TYPE(AD_InitInputType) :: AD !< AD Init input types [-] + TYPE(ADI_IW_InputData) :: IW_InitInp !< IW Init input types [-] + Character(1024) :: RootName !< RootName for writing output files [-] + LOGICAL :: storeHHVel = .false. !< If True, hub height velocity will be computed by infow wind [-] + INTEGER(IntKi) :: WrVTK = 0 !< 0= no vtk, 1=init only, 2=animation [-] + INTEGER(IntKi) :: WrVTK_Type = 1 !< Flag for VTK output type (1=surface, 2=line, 3=both) [-] + END TYPE ADI_InitInputType +! ======================= +! ========= ADI_InitOutputType ======= + TYPE, PUBLIC :: ADI_InitOutputType + TYPE(ProgDesc) :: Ver !< This module's name, version, and date [-] + character(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdr !< Channel headers [-] + character(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< Channel units [-] + END TYPE ADI_InitOutputType +! ======================= +! ========= ADI_ContinuousStateType ======= + TYPE, PUBLIC :: ADI_ContinuousStateType + TYPE(AD_ContinuousStateType) :: AD !< AD Continuous states [-] + END TYPE ADI_ContinuousStateType +! ======================= +! ========= ADI_DiscreteStateType ======= + TYPE, PUBLIC :: ADI_DiscreteStateType + TYPE(AD_DiscreteStateType) :: AD !< Discrete states [-] + END TYPE ADI_DiscreteStateType +! ======================= +! ========= ADI_ConstraintStateType ======= + TYPE, PUBLIC :: ADI_ConstraintStateType + TYPE(AD_ConstraintStateType) :: AD !< Constraint states [-] + END TYPE ADI_ConstraintStateType +! ======================= +! ========= ADI_OtherStateType ======= + TYPE, PUBLIC :: ADI_OtherStateType + TYPE(AD_OtherStateType) :: AD !< Other states [-] + END TYPE ADI_OtherStateType +! ======================= +! ========= ADI_MiscVarType ======= + TYPE, PUBLIC :: ADI_MiscVarType + TYPE(AD_MiscVarType) :: AD !< misc/optimization variables [-] + TYPE(ADI_InflowWindData) :: IW !< All the necessary inflow wind data [-] + TYPE(AD_VTK_RotSurfaceType) , DIMENSION(:), ALLOCATABLE :: VTK_surfaces !< VTK outputs surfaces for each rotor [-] + END TYPE ADI_MiscVarType +! ======================= +! ========= ADI_ParameterType ======= + TYPE, PUBLIC :: ADI_ParameterType + TYPE(AD_ParameterType) :: AD !< Parameters [-] + REAL(DbKi) :: dt !< time increment [s] + LOGICAL :: storeHHVel !< If True, hub height velocity will be computed by infow wind [-] + INTEGER(IntKi) :: wrVTK !< 0= no vtk, 1=init only, 2=animation [-] + INTEGER(IntKi) :: WrVTK_Type !< Flag for VTK output type (1=surface, 2=line, 3=both) [-] + INTEGER(IntKi) :: NumOuts = 0 !< Total number of WriteOutput outputs [-] + END TYPE ADI_ParameterType +! ======================= +! ========= ADI_InputType ======= + TYPE, PUBLIC :: ADI_InputType + TYPE(AD_InputType) :: AD !< Array of system inputs [-] + END TYPE ADI_InputType +! ======================= +! ========= ADI_OutputType ======= + TYPE, PUBLIC :: ADI_OutputType + TYPE(AD_OutputType) :: AD !< System outputs [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: HHVel !< Hub Height velocities for each rotors [-] + REAL(ReKi) :: PLExp !< Power law exponents (for outputs only) [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: IW_WriteOutput !< WriteOutputs for inflow wind [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WriteOutput !< System outputs [-] + END TYPE ADI_OutputType +! ======================= +! ========= ADI_Data ======= + TYPE, PUBLIC :: ADI_Data + TYPE(ADI_ContinuousStateType) :: x !< Continuous states [-] + TYPE(ADI_DiscreteStateType) :: xd !< Discrete states [-] + TYPE(ADI_ConstraintStateType) :: z !< Constraint states [-] + TYPE(ADI_OtherStateType) :: OtherState !< Other states [-] + TYPE(ADI_ParameterType) :: p !< Parameters [-] + TYPE(ADI_MiscVarType) :: m !< Misc/optimization variables [-] + TYPE(ADI_InputType) , DIMENSION(1:2) :: u !< Array of inputs associated with InputTimes [-] + TYPE(ADI_OutputType) :: y !< System outputs [-] + REAL(DbKi) , DIMENSION(1:2) :: inputTimes !< Array of times associated with u array [-] + END TYPE ADI_Data +! ======================= +! ========= RotFED ======= + TYPE, PUBLIC :: RotFED + TYPE(MeshType) :: PlatformPtMesh !< Platform reference point positions/orientations/velocities/accelerations [-] + TYPE(MeshType) :: TwrPtMesh !< (only if hasTower) Point mesh for tower base motion [-] + TYPE(MeshType) :: TwrPtMeshAD !< (only if hasTower) Point mesh for tower base for AD [-] + TYPE(MeshType) :: NacelleMotion !< Point mesh for nacelle point motion [-] + TYPE(MeshType) :: HubPtMotion !< Point mesh for hub point motion [-] + TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: BladeRootMotion !< BladeRootMotion Point mesh for blade root motion [-] + TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: BladeLn2Mesh !< (only if elastic blades) BladeLn2Mesh Line mesh along blade [-] + LOGICAL :: hasTower = .true. !< True if a tower is present [-] + LOGICAL :: rigidBlades = .true. !< True if blades are rigid (using BladeRootMotion) or not (Useing BldeLn2Mesh) [-] + INTEGER(IntKi) :: numBlades !< Number of blades [-] + TYPE(MeshMapType) :: ED_P_2_AD_P_T !< (only if hasTower) Mesh mapping from tower base to AD tower base [-] + TYPE(MeshMapType) :: AD_P_2_AD_L_T !< (only if hasTower) Mesh mapping from tower base to AD tower line [-] + TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: AD_P_2_AD_L_B !< (only for rigid blades) Mesh mapping from AD blade root to AD line mesh [-] + TYPE(MeshMapType) :: ED_P_2_AD_P_TF !< Map ElastoDyn TailFin CM point (taken as Nacelle) motion mesh to AeroDyn TailFin ref point motion mesh [-] + TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: ED_P_2_AD_P_R !< Map ElastoDyn BladeRootMotion point meshes to AeroDyn BladeRootMotion point meshes [-] + TYPE(MeshMapType) :: ED_P_2_AD_P_H !< Map ElastoDyn HubPtMotion point mesh to AeroDyn HubMotion point mesh [-] + TYPE(MeshMapType) :: ED_P_2_AD_P_N !< Map ElastoDyn Nacelle point motion mesh to AeroDyn Nacelle point motion mesh [-] + END TYPE RotFED +! ======================= +! ========= FED_Data ======= + TYPE, PUBLIC :: FED_Data + TYPE(RotFED) , DIMENSION(:), ALLOCATABLE :: WT !< Wind turbine/rotors elastic data [-] + END TYPE FED_Data +! ======================= +CONTAINS + SUBROUTINE ADI_CopyInflowWindData( SrcInflowWindDataData, DstInflowWindDataData, CtrlCode, ErrStat, ErrMsg ) + TYPE(ADI_InflowWindData), INTENT(IN) :: SrcInflowWindDataData + TYPE(ADI_InflowWindData), INTENT(INOUT) :: DstInflowWindDataData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ADI_CopyInflowWindData' +! + ErrStat = ErrID_None + ErrMsg = "" + CALL InflowWind_CopyContState( SrcInflowWindDataData%x, DstInflowWindDataData%x, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL InflowWind_CopyDiscState( SrcInflowWindDataData%xd, DstInflowWindDataData%xd, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL InflowWind_CopyConstrState( SrcInflowWindDataData%z, DstInflowWindDataData%z, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL InflowWind_CopyOtherState( SrcInflowWindDataData%OtherSt, DstInflowWindDataData%OtherSt, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL InflowWind_CopyParam( SrcInflowWindDataData%p, DstInflowWindDataData%p, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL InflowWind_CopyMisc( SrcInflowWindDataData%m, DstInflowWindDataData%m, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL InflowWind_CopyInput( SrcInflowWindDataData%u, DstInflowWindDataData%u, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL InflowWind_CopyOutput( SrcInflowWindDataData%y, DstInflowWindDataData%y, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + DstInflowWindDataData%CompInflow = SrcInflowWindDataData%CompInflow + DstInflowWindDataData%HWindSpeed = SrcInflowWindDataData%HWindSpeed + DstInflowWindDataData%RefHt = SrcInflowWindDataData%RefHt + DstInflowWindDataData%PLExp = SrcInflowWindDataData%PLExp + END SUBROUTINE ADI_CopyInflowWindData + + SUBROUTINE ADI_DestroyInflowWindData( InflowWindDataData, ErrStat, ErrMsg, DEALLOCATEpointers ) + TYPE(ADI_InflowWindData), INTENT(INOUT) :: InflowWindDataData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + LOGICAL :: DEALLOCATEpointers_local + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ADI_DestroyInflowWindData' + + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + + CALL InflowWind_DestroyContState( InflowWindDataData%x, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL InflowWind_DestroyDiscState( InflowWindDataData%xd, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL InflowWind_DestroyConstrState( InflowWindDataData%z, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL InflowWind_DestroyOtherState( InflowWindDataData%OtherSt, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL InflowWind_DestroyParam( InflowWindDataData%p, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL InflowWind_DestroyMisc( InflowWindDataData%m, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL InflowWind_DestroyInput( InflowWindDataData%u, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL InflowWind_DestroyOutput( InflowWindDataData%y, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + END SUBROUTINE ADI_DestroyInflowWindData + + SUBROUTINE ADI_PackInflowWindData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(ADI_InflowWindData), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ADI_PackInflowWindData' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype + CALL InflowWind_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x, ErrStat2, ErrMsg2, .TRUE. ) ! x + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! x + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! x + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! x + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype + CALL InflowWind_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd, ErrStat2, ErrMsg2, .TRUE. ) ! xd + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! xd + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! xd + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! xd + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype + CALL InflowWind_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z, ErrStat2, ErrMsg2, .TRUE. ) ! z + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! z + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! z + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! z + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype + CALL InflowWind_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt, ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! OtherSt + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OtherSt + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OtherSt + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype + CALL InflowWind_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! p + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! p + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! p + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype + CALL InflowWind_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! m + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! m + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! m + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype + CALL InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! u + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! u + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! u + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype + CALL InflowWind_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! y + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! y + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! y + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 1 ! CompInflow + Re_BufSz = Re_BufSz + 1 ! HWindSpeed + Re_BufSz = Re_BufSz + 1 ! RefHt + Re_BufSz = Re_BufSz + 1 ! PLExp + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + CALL InflowWind_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x, ErrStat2, ErrMsg2, OnlySize ) ! x + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL InflowWind_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd, ErrStat2, ErrMsg2, OnlySize ) ! xd + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL InflowWind_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z, ErrStat2, ErrMsg2, OnlySize ) ! z + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL InflowWind_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt, ErrStat2, ErrMsg2, OnlySize ) ! OtherSt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL InflowWind_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL InflowWind_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL InflowWind_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IntKiBuf(Int_Xferred) = InData%CompInflow + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HWindSpeed + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RefHt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PLExp + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE ADI_PackInflowWindData + + SUBROUTINE ADI_UnPackInflowWindData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(ADI_InflowWindData), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ADI_UnPackInflowWindData' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL InflowWind_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x, ErrStat2, ErrMsg2 ) ! x + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL InflowWind_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd, ErrStat2, ErrMsg2 ) ! xd + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL InflowWind_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z, ErrStat2, ErrMsg2 ) ! z + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL InflowWind_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt, ErrStat2, ErrMsg2 ) ! OtherSt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL InflowWind_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL InflowWind_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL InflowWind_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL InflowWind_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + OutData%CompInflow = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%HWindSpeed = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RefHt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PLExp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE ADI_UnPackInflowWindData + + SUBROUTINE ADI_CopyIW_InputData( SrcIW_InputDataData, DstIW_InputDataData, CtrlCode, ErrStat, ErrMsg ) + TYPE(ADI_IW_InputData), INTENT(IN) :: SrcIW_InputDataData + TYPE(ADI_IW_InputData), INTENT(INOUT) :: DstIW_InputDataData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ADI_CopyIW_InputData' +! + ErrStat = ErrID_None + ErrMsg = "" + DstIW_InputDataData%InputFile = SrcIW_InputDataData%InputFile + DstIW_InputDataData%CompInflow = SrcIW_InputDataData%CompInflow + DstIW_InputDataData%HWindSpeed = SrcIW_InputDataData%HWindSpeed + DstIW_InputDataData%RefHt = SrcIW_InputDataData%RefHt + DstIW_InputDataData%PLExp = SrcIW_InputDataData%PLExp + DstIW_InputDataData%UseInputFile = SrcIW_InputDataData%UseInputFile + CALL NWTC_Library_Copyfileinfotype( SrcIW_InputDataData%PassedFileData, DstIW_InputDataData%PassedFileData, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + DstIW_InputDataData%Linearize = SrcIW_InputDataData%Linearize + END SUBROUTINE ADI_CopyIW_InputData + + SUBROUTINE ADI_DestroyIW_InputData( IW_InputDataData, ErrStat, ErrMsg, DEALLOCATEpointers ) + TYPE(ADI_IW_InputData), INTENT(INOUT) :: IW_InputDataData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + LOGICAL :: DEALLOCATEpointers_local + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ADI_DestroyIW_InputData' + + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + + CALL NWTC_Library_Destroyfileinfotype( IW_InputDataData%PassedFileData, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + END SUBROUTINE ADI_DestroyIW_InputData + + SUBROUTINE ADI_PackIW_InputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(ADI_IW_InputData), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ADI_PackIW_InputData' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1*LEN(InData%InputFile) ! InputFile + Int_BufSz = Int_BufSz + 1 ! CompInflow + Re_BufSz = Re_BufSz + 1 ! HWindSpeed + Re_BufSz = Re_BufSz + 1 ! RefHt + Re_BufSz = Re_BufSz + 1 ! PLExp + Int_BufSz = Int_BufSz + 1 ! UseInputFile + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + Int_BufSz = Int_BufSz + 3 ! PassedFileData: size of buffers for each call to pack subtype + CALL NWTC_Library_Packfileinfotype( Re_Buf, Db_Buf, Int_Buf, InData%PassedFileData, ErrStat2, ErrMsg2, .TRUE. ) ! PassedFileData + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! PassedFileData + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! PassedFileData + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! PassedFileData + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 1 ! Linearize + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + DO I = 1, LEN(InData%InputFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%CompInflow + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HWindSpeed + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RefHt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PLExp + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%UseInputFile, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + CALL NWTC_Library_Packfileinfotype( Re_Buf, Db_Buf, Int_Buf, InData%PassedFileData, ErrStat2, ErrMsg2, OnlySize ) ! PassedFileData + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IntKiBuf(Int_Xferred) = TRANSFER(InData%Linearize, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END SUBROUTINE ADI_PackIW_InputData + + SUBROUTINE ADI_UnPackIW_InputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(ADI_IW_InputData), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ADI_UnPackIW_InputData' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + DO I = 1, LEN(OutData%InputFile) + OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%CompInflow = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%HWindSpeed = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RefHt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PLExp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%UseInputFile = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseInputFile) + Int_Xferred = Int_Xferred + 1 + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackfileinfotype( Re_Buf, Db_Buf, Int_Buf, OutData%PassedFileData, ErrStat2, ErrMsg2 ) ! PassedFileData + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + OutData%Linearize = TRANSFER(IntKiBuf(Int_Xferred), OutData%Linearize) + Int_Xferred = Int_Xferred + 1 + END SUBROUTINE ADI_UnPackIW_InputData + + SUBROUTINE ADI_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) + TYPE(ADI_InitInputType), INTENT(IN) :: SrcInitInputData + TYPE(ADI_InitInputType), INTENT(INOUT) :: DstInitInputData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ADI_CopyInitInput' +! + ErrStat = ErrID_None + ErrMsg = "" + CALL AD_CopyInitInput( SrcInitInputData%AD, DstInitInputData%AD, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL ADI_Copyiw_inputdata( SrcInitInputData%IW_InitInp, DstInitInputData%IW_InitInp, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + DstInitInputData%RootName = SrcInitInputData%RootName + DstInitInputData%storeHHVel = SrcInitInputData%storeHHVel + DstInitInputData%WrVTK = SrcInitInputData%WrVTK + DstInitInputData%WrVTK_Type = SrcInitInputData%WrVTK_Type + END SUBROUTINE ADI_CopyInitInput + + SUBROUTINE ADI_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + TYPE(ADI_InitInputType), INTENT(INOUT) :: InitInputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + LOGICAL :: DEALLOCATEpointers_local + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ADI_DestroyInitInput' + + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + + CALL AD_DestroyInitInput( InitInputData%AD, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL ADI_Destroyiw_inputdata( InitInputData%IW_InitInp, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + END SUBROUTINE ADI_DestroyInitInput + + SUBROUTINE ADI_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(ADI_InitInputType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ADI_PackInitInput' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + Int_BufSz = Int_BufSz + 3 ! AD: size of buffers for each call to pack subtype + CALL AD_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%AD, ErrStat2, ErrMsg2, .TRUE. ) ! AD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! AD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! AD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! AD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! IW_InitInp: size of buffers for each call to pack subtype + CALL ADI_Packiw_inputdata( Re_Buf, Db_Buf, Int_Buf, InData%IW_InitInp, ErrStat2, ErrMsg2, .TRUE. ) ! IW_InitInp + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! IW_InitInp + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! IW_InitInp + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! IW_InitInp + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName + Int_BufSz = Int_BufSz + 1 ! storeHHVel + Int_BufSz = Int_BufSz + 1 ! WrVTK + Int_BufSz = Int_BufSz + 1 ! WrVTK_Type + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + CALL AD_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%AD, ErrStat2, ErrMsg2, OnlySize ) ! AD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL ADI_Packiw_inputdata( Re_Buf, Db_Buf, Int_Buf, InData%IW_InitInp, ErrStat2, ErrMsg2, OnlySize ) ! IW_InitInp + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + DO I = 1, LEN(InData%RootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%storeHHVel, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%WrVTK + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%WrVTK_Type + Int_Xferred = Int_Xferred + 1 + END SUBROUTINE ADI_PackInitInput + + SUBROUTINE ADI_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(ADI_InitInputType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ADI_UnPackInitInput' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL AD_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%AD, ErrStat2, ErrMsg2 ) ! AD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL ADI_Unpackiw_inputdata( Re_Buf, Db_Buf, Int_Buf, OutData%IW_InitInp, ErrStat2, ErrMsg2 ) ! IW_InitInp + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + DO I = 1, LEN(OutData%RootName) + OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%storeHHVel = TRANSFER(IntKiBuf(Int_Xferred), OutData%storeHHVel) + Int_Xferred = Int_Xferred + 1 + OutData%WrVTK = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%WrVTK_Type = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END SUBROUTINE ADI_UnPackInitInput + + SUBROUTINE ADI_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) + TYPE(ADI_InitOutputType), INTENT(IN) :: SrcInitOutputData + TYPE(ADI_InitOutputType), INTENT(INOUT) :: DstInitOutputData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ADI_CopyInitOutput' +! + ErrStat = ErrID_None + ErrMsg = "" + CALL NWTC_Library_Copyprogdesc( SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcInitOutputData%WriteOutputHdr)) THEN + i1_l = LBOUND(SrcInitOutputData%WriteOutputHdr,1) + i1_u = UBOUND(SrcInitOutputData%WriteOutputHdr,1) + IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputHdr)) THEN + ALLOCATE(DstInitOutputData%WriteOutputHdr(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr +ENDIF +IF (ALLOCATED(SrcInitOutputData%WriteOutputUnt)) THEN + i1_l = LBOUND(SrcInitOutputData%WriteOutputUnt,1) + i1_u = UBOUND(SrcInitOutputData%WriteOutputUnt,1) + IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputUnt)) THEN + ALLOCATE(DstInitOutputData%WriteOutputUnt(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt +ENDIF + END SUBROUTINE ADI_CopyInitOutput + + SUBROUTINE ADI_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + TYPE(ADI_InitOutputType), INTENT(INOUT) :: InitOutputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + LOGICAL :: DEALLOCATEpointers_local + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ADI_DestroyInitOutput' + + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + + CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN + DEALLOCATE(InitOutputData%WriteOutputHdr) +ENDIF +IF (ALLOCATED(InitOutputData%WriteOutputUnt)) THEN + DEALLOCATE(InitOutputData%WriteOutputUnt) +ENDIF + END SUBROUTINE ADI_DestroyInitOutput + + SUBROUTINE ADI_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(ADI_InitOutputType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ADI_PackInitOutput' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + Int_BufSz = Int_BufSz + 3 ! Ver: size of buffers for each call to pack subtype + CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Ver + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Ver + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Ver + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 1 ! WriteOutputHdr allocated yes/no + IF ( ALLOCATED(InData%WriteOutputHdr) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! WriteOutputHdr upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputHdr)*LEN(InData%WriteOutputHdr) ! WriteOutputHdr + END IF + Int_BufSz = Int_BufSz + 1 ! WriteOutputUnt allocated yes/no + IF ( ALLOCATED(InData%WriteOutputUnt) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! WriteOutputUnt upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputUnt)*LEN(InData%WriteOutputUnt) ! WriteOutputUnt + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF ( .NOT. ALLOCATED(InData%WriteOutputHdr) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputHdr,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) + DO I = 1, LEN(InData%WriteOutputHdr) + IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputHdr(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputUnt,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) + DO I = 1, LEN(InData%WriteOutputUnt) + IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputUnt(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + END SUBROUTINE ADI_PackInitOutput + + SUBROUTINE ADI_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(ADI_InitOutputType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ADI_UnPackInitOutput' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackprogdesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputHdr not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WriteOutputHdr)) DEALLOCATE(OutData%WriteOutputHdr) + ALLOCATE(OutData%WriteOutputHdr(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) + DO I = 1, LEN(OutData%WriteOutputHdr) + OutData%WriteOutputHdr(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WriteOutputUnt)) DEALLOCATE(OutData%WriteOutputUnt) + ALLOCATE(OutData%WriteOutputUnt(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) + DO I = 1, LEN(OutData%WriteOutputUnt) + OutData%WriteOutputUnt(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + END SUBROUTINE ADI_UnPackInitOutput + + SUBROUTINE ADI_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) + TYPE(ADI_ContinuousStateType), INTENT(IN) :: SrcContStateData + TYPE(ADI_ContinuousStateType), INTENT(INOUT) :: DstContStateData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ADI_CopyContState' +! + ErrStat = ErrID_None + ErrMsg = "" + CALL AD_CopyContState( SrcContStateData%AD, DstContStateData%AD, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + END SUBROUTINE ADI_CopyContState + + SUBROUTINE ADI_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + TYPE(ADI_ContinuousStateType), INTENT(INOUT) :: ContStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + LOGICAL :: DEALLOCATEpointers_local + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ADI_DestroyContState' + + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + + CALL AD_DestroyContState( ContStateData%AD, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + END SUBROUTINE ADI_DestroyContState + + SUBROUTINE ADI_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(ADI_ContinuousStateType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ADI_PackContState' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + Int_BufSz = Int_BufSz + 3 ! AD: size of buffers for each call to pack subtype + CALL AD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%AD, ErrStat2, ErrMsg2, .TRUE. ) ! AD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! AD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! AD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! AD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + CALL AD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%AD, ErrStat2, ErrMsg2, OnlySize ) ! AD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END SUBROUTINE ADI_PackContState + + SUBROUTINE ADI_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(ADI_ContinuousStateType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ADI_UnPackContState' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL AD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%AD, ErrStat2, ErrMsg2 ) ! AD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END SUBROUTINE ADI_UnPackContState + + SUBROUTINE ADI_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) + TYPE(ADI_DiscreteStateType), INTENT(IN) :: SrcDiscStateData + TYPE(ADI_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ADI_CopyDiscState' +! + ErrStat = ErrID_None + ErrMsg = "" + CALL AD_CopyDiscState( SrcDiscStateData%AD, DstDiscStateData%AD, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + END SUBROUTINE ADI_CopyDiscState + + SUBROUTINE ADI_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + TYPE(ADI_DiscreteStateType), INTENT(INOUT) :: DiscStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + LOGICAL :: DEALLOCATEpointers_local + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ADI_DestroyDiscState' + + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + + CALL AD_DestroyDiscState( DiscStateData%AD, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + END SUBROUTINE ADI_DestroyDiscState + + SUBROUTINE ADI_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(ADI_DiscreteStateType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ADI_PackDiscState' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + Int_BufSz = Int_BufSz + 3 ! AD: size of buffers for each call to pack subtype + CALL AD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%AD, ErrStat2, ErrMsg2, .TRUE. ) ! AD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! AD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! AD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! AD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + CALL AD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%AD, ErrStat2, ErrMsg2, OnlySize ) ! AD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END SUBROUTINE ADI_PackDiscState + + SUBROUTINE ADI_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(ADI_DiscreteStateType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ADI_UnPackDiscState' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL AD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%AD, ErrStat2, ErrMsg2 ) ! AD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END SUBROUTINE ADI_UnPackDiscState + + SUBROUTINE ADI_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) + TYPE(ADI_ConstraintStateType), INTENT(IN) :: SrcConstrStateData + TYPE(ADI_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ADI_CopyConstrState' +! + ErrStat = ErrID_None + ErrMsg = "" + CALL AD_CopyConstrState( SrcConstrStateData%AD, DstConstrStateData%AD, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + END SUBROUTINE ADI_CopyConstrState + + SUBROUTINE ADI_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + TYPE(ADI_ConstraintStateType), INTENT(INOUT) :: ConstrStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + LOGICAL :: DEALLOCATEpointers_local + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ADI_DestroyConstrState' + + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + + CALL AD_DestroyConstrState( ConstrStateData%AD, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + END SUBROUTINE ADI_DestroyConstrState + + SUBROUTINE ADI_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(ADI_ConstraintStateType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ADI_PackConstrState' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + Int_BufSz = Int_BufSz + 3 ! AD: size of buffers for each call to pack subtype + CALL AD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%AD, ErrStat2, ErrMsg2, .TRUE. ) ! AD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! AD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! AD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! AD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + CALL AD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%AD, ErrStat2, ErrMsg2, OnlySize ) ! AD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END SUBROUTINE ADI_PackConstrState + + SUBROUTINE ADI_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(ADI_ConstraintStateType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ADI_UnPackConstrState' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL AD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%AD, ErrStat2, ErrMsg2 ) ! AD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END SUBROUTINE ADI_UnPackConstrState + + SUBROUTINE ADI_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) + TYPE(ADI_OtherStateType), INTENT(IN) :: SrcOtherStateData + TYPE(ADI_OtherStateType), INTENT(INOUT) :: DstOtherStateData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ADI_CopyOtherState' +! + ErrStat = ErrID_None + ErrMsg = "" + CALL AD_CopyOtherState( SrcOtherStateData%AD, DstOtherStateData%AD, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + END SUBROUTINE ADI_CopyOtherState + + SUBROUTINE ADI_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + TYPE(ADI_OtherStateType), INTENT(INOUT) :: OtherStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + LOGICAL :: DEALLOCATEpointers_local + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ADI_DestroyOtherState' + + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + + CALL AD_DestroyOtherState( OtherStateData%AD, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + END SUBROUTINE ADI_DestroyOtherState + + SUBROUTINE ADI_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(ADI_OtherStateType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ADI_PackOtherState' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + Int_BufSz = Int_BufSz + 3 ! AD: size of buffers for each call to pack subtype + CALL AD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%AD, ErrStat2, ErrMsg2, .TRUE. ) ! AD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! AD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! AD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! AD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + CALL AD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%AD, ErrStat2, ErrMsg2, OnlySize ) ! AD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END SUBROUTINE ADI_PackOtherState + + SUBROUTINE ADI_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(ADI_OtherStateType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ADI_UnPackOtherState' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL AD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%AD, ErrStat2, ErrMsg2 ) ! AD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END SUBROUTINE ADI_UnPackOtherState + + SUBROUTINE ADI_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) + TYPE(ADI_MiscVarType), INTENT(INOUT) :: SrcMiscData + TYPE(ADI_MiscVarType), INTENT(INOUT) :: DstMiscData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ADI_CopyMisc' +! + ErrStat = ErrID_None + ErrMsg = "" + CALL AD_CopyMisc( SrcMiscData%AD, DstMiscData%AD, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL ADI_Copyinflowwinddata( SrcMiscData%IW, DstMiscData%IW, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcMiscData%VTK_surfaces)) THEN + i1_l = LBOUND(SrcMiscData%VTK_surfaces,1) + i1_u = UBOUND(SrcMiscData%VTK_surfaces,1) + IF (.NOT. ALLOCATED(DstMiscData%VTK_surfaces)) THEN + ALLOCATE(DstMiscData%VTK_surfaces(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%VTK_surfaces.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcMiscData%VTK_surfaces,1), UBOUND(SrcMiscData%VTK_surfaces,1) + CALL AD_Copyvtk_rotsurfacetype( SrcMiscData%VTK_surfaces(i1), DstMiscData%VTK_surfaces(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF + END SUBROUTINE ADI_CopyMisc + + SUBROUTINE ADI_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) + TYPE(ADI_MiscVarType), INTENT(INOUT) :: MiscData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + LOGICAL :: DEALLOCATEpointers_local + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ADI_DestroyMisc' + + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + + CALL AD_DestroyMisc( MiscData%AD, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL ADI_Destroyinflowwinddata( MiscData%IW, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +IF (ALLOCATED(MiscData%VTK_surfaces)) THEN +DO i1 = LBOUND(MiscData%VTK_surfaces,1), UBOUND(MiscData%VTK_surfaces,1) + CALL AD_Destroyvtk_rotsurfacetype( MiscData%VTK_surfaces(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(MiscData%VTK_surfaces) +ENDIF + END SUBROUTINE ADI_DestroyMisc + + SUBROUTINE ADI_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(ADI_MiscVarType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ADI_PackMisc' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + Int_BufSz = Int_BufSz + 3 ! AD: size of buffers for each call to pack subtype + CALL AD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%AD, ErrStat2, ErrMsg2, .TRUE. ) ! AD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! AD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! AD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! AD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! IW: size of buffers for each call to pack subtype + CALL ADI_Packinflowwinddata( Re_Buf, Db_Buf, Int_Buf, InData%IW, ErrStat2, ErrMsg2, .TRUE. ) ! IW + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! IW + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! IW + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! IW + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 1 ! VTK_surfaces allocated yes/no + IF ( ALLOCATED(InData%VTK_surfaces) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! VTK_surfaces upper/lower bounds for each dimension + DO i1 = LBOUND(InData%VTK_surfaces,1), UBOUND(InData%VTK_surfaces,1) + Int_BufSz = Int_BufSz + 3 ! VTK_surfaces: size of buffers for each call to pack subtype + CALL AD_Packvtk_rotsurfacetype( Re_Buf, Db_Buf, Int_Buf, InData%VTK_surfaces(i1), ErrStat2, ErrMsg2, .TRUE. ) ! VTK_surfaces + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! VTK_surfaces + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! VTK_surfaces + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! VTK_surfaces + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + CALL AD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%AD, ErrStat2, ErrMsg2, OnlySize ) ! AD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL ADI_Packinflowwinddata( Re_Buf, Db_Buf, Int_Buf, InData%IW, ErrStat2, ErrMsg2, OnlySize ) ! IW + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF ( .NOT. ALLOCATED(InData%VTK_surfaces) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%VTK_surfaces,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VTK_surfaces,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%VTK_surfaces,1), UBOUND(InData%VTK_surfaces,1) + CALL AD_Packvtk_rotsurfacetype( Re_Buf, Db_Buf, Int_Buf, InData%VTK_surfaces(i1), ErrStat2, ErrMsg2, OnlySize ) ! VTK_surfaces + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + END SUBROUTINE ADI_PackMisc + + SUBROUTINE ADI_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(ADI_MiscVarType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ADI_UnPackMisc' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL AD_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%AD, ErrStat2, ErrMsg2 ) ! AD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL ADI_Unpackinflowwinddata( Re_Buf, Db_Buf, Int_Buf, OutData%IW, ErrStat2, ErrMsg2 ) ! IW + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! VTK_surfaces not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%VTK_surfaces)) DEALLOCATE(OutData%VTK_surfaces) + ALLOCATE(OutData%VTK_surfaces(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%VTK_surfaces.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%VTK_surfaces,1), UBOUND(OutData%VTK_surfaces,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL AD_Unpackvtk_rotsurfacetype( Re_Buf, Db_Buf, Int_Buf, OutData%VTK_surfaces(i1), ErrStat2, ErrMsg2 ) ! VTK_surfaces + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + END SUBROUTINE ADI_UnPackMisc + + SUBROUTINE ADI_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) + TYPE(ADI_ParameterType), INTENT(IN) :: SrcParamData + TYPE(ADI_ParameterType), INTENT(INOUT) :: DstParamData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ADI_CopyParam' +! + ErrStat = ErrID_None + ErrMsg = "" + CALL AD_CopyParam( SrcParamData%AD, DstParamData%AD, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + DstParamData%dt = SrcParamData%dt + DstParamData%storeHHVel = SrcParamData%storeHHVel + DstParamData%wrVTK = SrcParamData%wrVTK + DstParamData%WrVTK_Type = SrcParamData%WrVTK_Type + DstParamData%NumOuts = SrcParamData%NumOuts + END SUBROUTINE ADI_CopyParam + + SUBROUTINE ADI_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) + TYPE(ADI_ParameterType), INTENT(INOUT) :: ParamData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + LOGICAL :: DEALLOCATEpointers_local + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ADI_DestroyParam' + + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + + CALL AD_DestroyParam( ParamData%AD, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + END SUBROUTINE ADI_DestroyParam + + SUBROUTINE ADI_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(ADI_ParameterType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ADI_PackParam' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + Int_BufSz = Int_BufSz + 3 ! AD: size of buffers for each call to pack subtype + CALL AD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%AD, ErrStat2, ErrMsg2, .TRUE. ) ! AD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! AD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! AD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! AD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Db_BufSz = Db_BufSz + 1 ! dt + Int_BufSz = Int_BufSz + 1 ! storeHHVel + Int_BufSz = Int_BufSz + 1 ! wrVTK + Int_BufSz = Int_BufSz + 1 ! WrVTK_Type + Int_BufSz = Int_BufSz + 1 ! NumOuts + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + CALL AD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%AD, ErrStat2, ErrMsg2, OnlySize ) ! AD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + DbKiBuf(Db_Xferred) = InData%dt + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%storeHHVel, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%wrVTK + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%WrVTK_Type + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 + END SUBROUTINE ADI_PackParam + + SUBROUTINE ADI_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(ADI_ParameterType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ADI_UnPackParam' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL AD_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%AD, ErrStat2, ErrMsg2 ) ! AD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + OutData%dt = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%storeHHVel = TRANSFER(IntKiBuf(Int_Xferred), OutData%storeHHVel) + Int_Xferred = Int_Xferred + 1 + OutData%wrVTK = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%WrVTK_Type = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END SUBROUTINE ADI_UnPackParam + + SUBROUTINE ADI_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) + TYPE(ADI_InputType), INTENT(INOUT) :: SrcInputData + TYPE(ADI_InputType), INTENT(INOUT) :: DstInputData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ADI_CopyInput' +! + ErrStat = ErrID_None + ErrMsg = "" + CALL AD_CopyInput( SrcInputData%AD, DstInputData%AD, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + END SUBROUTINE ADI_CopyInput + + SUBROUTINE ADI_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + TYPE(ADI_InputType), INTENT(INOUT) :: InputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + LOGICAL :: DEALLOCATEpointers_local + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ADI_DestroyInput' + + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + + CALL AD_DestroyInput( InputData%AD, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + END SUBROUTINE ADI_DestroyInput + + SUBROUTINE ADI_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(ADI_InputType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ADI_PackInput' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + Int_BufSz = Int_BufSz + 3 ! AD: size of buffers for each call to pack subtype + CALL AD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%AD, ErrStat2, ErrMsg2, .TRUE. ) ! AD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! AD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! AD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! AD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + CALL AD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%AD, ErrStat2, ErrMsg2, OnlySize ) ! AD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END SUBROUTINE ADI_PackInput + + SUBROUTINE ADI_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(ADI_InputType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ADI_UnPackInput' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL AD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%AD, ErrStat2, ErrMsg2 ) ! AD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END SUBROUTINE ADI_UnPackInput + + SUBROUTINE ADI_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) + TYPE(ADI_OutputType), INTENT(INOUT) :: SrcOutputData + TYPE(ADI_OutputType), INTENT(INOUT) :: DstOutputData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ADI_CopyOutput' +! + ErrStat = ErrID_None + ErrMsg = "" + CALL AD_CopyOutput( SrcOutputData%AD, DstOutputData%AD, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcOutputData%HHVel)) THEN + i1_l = LBOUND(SrcOutputData%HHVel,1) + i1_u = UBOUND(SrcOutputData%HHVel,1) + i2_l = LBOUND(SrcOutputData%HHVel,2) + i2_u = UBOUND(SrcOutputData%HHVel,2) + IF (.NOT. ALLOCATED(DstOutputData%HHVel)) THEN + ALLOCATE(DstOutputData%HHVel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%HHVel.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstOutputData%HHVel = SrcOutputData%HHVel +ENDIF + DstOutputData%PLExp = SrcOutputData%PLExp +IF (ALLOCATED(SrcOutputData%IW_WriteOutput)) THEN + i1_l = LBOUND(SrcOutputData%IW_WriteOutput,1) + i1_u = UBOUND(SrcOutputData%IW_WriteOutput,1) + IF (.NOT. ALLOCATED(DstOutputData%IW_WriteOutput)) THEN + ALLOCATE(DstOutputData%IW_WriteOutput(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%IW_WriteOutput.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstOutputData%IW_WriteOutput = SrcOutputData%IW_WriteOutput +ENDIF +IF (ALLOCATED(SrcOutputData%WriteOutput)) THEN + i1_l = LBOUND(SrcOutputData%WriteOutput,1) + i1_u = UBOUND(SrcOutputData%WriteOutput,1) + IF (.NOT. ALLOCATED(DstOutputData%WriteOutput)) THEN + ALLOCATE(DstOutputData%WriteOutput(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutput.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstOutputData%WriteOutput = SrcOutputData%WriteOutput +ENDIF + END SUBROUTINE ADI_CopyOutput + + SUBROUTINE ADI_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + TYPE(ADI_OutputType), INTENT(INOUT) :: OutputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + LOGICAL :: DEALLOCATEpointers_local + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ADI_DestroyOutput' + + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + + CALL AD_DestroyOutput( OutputData%AD, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +IF (ALLOCATED(OutputData%HHVel)) THEN + DEALLOCATE(OutputData%HHVel) +ENDIF +IF (ALLOCATED(OutputData%IW_WriteOutput)) THEN + DEALLOCATE(OutputData%IW_WriteOutput) +ENDIF +IF (ALLOCATED(OutputData%WriteOutput)) THEN + DEALLOCATE(OutputData%WriteOutput) +ENDIF + END SUBROUTINE ADI_DestroyOutput + + SUBROUTINE ADI_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(ADI_OutputType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ADI_PackOutput' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + Int_BufSz = Int_BufSz + 3 ! AD: size of buffers for each call to pack subtype + CALL AD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%AD, ErrStat2, ErrMsg2, .TRUE. ) ! AD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! AD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! AD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! AD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 1 ! HHVel allocated yes/no + IF ( ALLOCATED(InData%HHVel) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! HHVel upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%HHVel) ! HHVel + END IF + Re_BufSz = Re_BufSz + 1 ! PLExp + Int_BufSz = Int_BufSz + 1 ! IW_WriteOutput allocated yes/no + IF ( ALLOCATED(InData%IW_WriteOutput) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! IW_WriteOutput upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%IW_WriteOutput) ! IW_WriteOutput + END IF + Int_BufSz = Int_BufSz + 1 ! WriteOutput allocated yes/no + IF ( ALLOCATED(InData%WriteOutput) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! WriteOutput upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WriteOutput) ! WriteOutput + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + CALL AD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%AD, ErrStat2, ErrMsg2, OnlySize ) ! AD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF ( .NOT. ALLOCATED(InData%HHVel) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%HHVel,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%HHVel,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%HHVel,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%HHVel,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%HHVel,2), UBOUND(InData%HHVel,2) + DO i1 = LBOUND(InData%HHVel,1), UBOUND(InData%HHVel,1) + ReKiBuf(Re_Xferred) = InData%HHVel(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + ReKiBuf(Re_Xferred) = InData%PLExp + Re_Xferred = Re_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%IW_WriteOutput) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%IW_WriteOutput,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IW_WriteOutput,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%IW_WriteOutput,1), UBOUND(InData%IW_WriteOutput,1) + ReKiBuf(Re_Xferred) = InData%IW_WriteOutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%WriteOutput) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutput,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) + ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + END SUBROUTINE ADI_PackOutput + + SUBROUTINE ADI_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(ADI_OutputType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ADI_UnPackOutput' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL AD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%AD, ErrStat2, ErrMsg2 ) ! AD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! HHVel not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%HHVel)) DEALLOCATE(OutData%HHVel) + ALLOCATE(OutData%HHVel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%HHVel.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%HHVel,2), UBOUND(OutData%HHVel,2) + DO i1 = LBOUND(OutData%HHVel,1), UBOUND(OutData%HHVel,1) + OutData%HHVel(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + OutData%PLExp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IW_WriteOutput not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%IW_WriteOutput)) DEALLOCATE(OutData%IW_WriteOutput) + ALLOCATE(OutData%IW_WriteOutput(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IW_WriteOutput.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%IW_WriteOutput,1), UBOUND(OutData%IW_WriteOutput,1) + OutData%IW_WriteOutput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutput not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WriteOutput)) DEALLOCATE(OutData%WriteOutput) + ALLOCATE(OutData%WriteOutput(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) + OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + END SUBROUTINE ADI_UnPackOutput + + SUBROUTINE ADI_CopyData( SrcDataData, DstDataData, CtrlCode, ErrStat, ErrMsg ) + TYPE(ADI_Data), INTENT(INOUT) :: SrcDataData + TYPE(ADI_Data), INTENT(INOUT) :: DstDataData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ADI_CopyData' +! + ErrStat = ErrID_None + ErrMsg = "" + CALL ADI_CopyContState( SrcDataData%x, DstDataData%x, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL ADI_CopyDiscState( SrcDataData%xd, DstDataData%xd, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL ADI_CopyConstrState( SrcDataData%z, DstDataData%z, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL ADI_CopyOtherState( SrcDataData%OtherState, DstDataData%OtherState, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL ADI_CopyParam( SrcDataData%p, DstDataData%p, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL ADI_CopyMisc( SrcDataData%m, DstDataData%m, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + DO i1 = LBOUND(SrcDataData%u,1), UBOUND(SrcDataData%u,1) + CALL ADI_CopyInput( SrcDataData%u(i1), DstDataData%u(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + CALL ADI_CopyOutput( SrcDataData%y, DstDataData%y, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + DstDataData%inputTimes = SrcDataData%inputTimes + END SUBROUTINE ADI_CopyData + + SUBROUTINE ADI_DestroyData( DataData, ErrStat, ErrMsg, DEALLOCATEpointers ) + TYPE(ADI_Data), INTENT(INOUT) :: DataData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + LOGICAL :: DEALLOCATEpointers_local + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ADI_DestroyData' + + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + + CALL ADI_DestroyContState( DataData%x, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL ADI_DestroyDiscState( DataData%xd, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL ADI_DestroyConstrState( DataData%z, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL ADI_DestroyOtherState( DataData%OtherState, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL ADI_DestroyParam( DataData%p, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL ADI_DestroyMisc( DataData%m, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +DO i1 = LBOUND(DataData%u,1), UBOUND(DataData%u,1) + CALL ADI_DestroyInput( DataData%u(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + CALL ADI_DestroyOutput( DataData%y, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + END SUBROUTINE ADI_DestroyData + + SUBROUTINE ADI_PackData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(ADI_Data), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ADI_PackData' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype + CALL ADI_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x, ErrStat2, ErrMsg2, .TRUE. ) ! x + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! x + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! x + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! x + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype + CALL ADI_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd, ErrStat2, ErrMsg2, .TRUE. ) ! xd + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! xd + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! xd + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! xd + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype + CALL ADI_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z, ErrStat2, ErrMsg2, .TRUE. ) ! z + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! z + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! z + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! z + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! OtherState: size of buffers for each call to pack subtype + CALL ADI_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherState, ErrStat2, ErrMsg2, .TRUE. ) ! OtherState + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! OtherState + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OtherState + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OtherState + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype + CALL ADI_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! p + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! p + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! p + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype + CALL ADI_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! m + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! m + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! m + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + DO i1 = LBOUND(InData%u,1), UBOUND(InData%u,1) + Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype + CALL ADI_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! u + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! u + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! u + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype + CALL ADI_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! y + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! y + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! y + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Db_BufSz = Db_BufSz + SIZE(InData%inputTimes) ! inputTimes + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END 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 ADI_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x, ErrStat2, ErrMsg2, OnlySize ) ! x + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL ADI_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd, ErrStat2, ErrMsg2, OnlySize ) ! xd + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL ADI_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z, ErrStat2, ErrMsg2, OnlySize ) ! z + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL ADI_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherState, ErrStat2, ErrMsg2, OnlySize ) ! OtherState + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL ADI_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL ADI_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + DO i1 = LBOUND(InData%u,1), UBOUND(InData%u,1) + CALL ADI_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u(i1), ErrStat2, ErrMsg2, OnlySize ) ! u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + CALL ADI_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + DO i1 = LBOUND(InData%inputTimes,1), UBOUND(InData%inputTimes,1) + DbKiBuf(Db_Xferred) = InData%inputTimes(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END SUBROUTINE ADI_PackData + + SUBROUTINE ADI_UnPackData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(ADI_Data), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ADI_UnPackData' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL ADI_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x, ErrStat2, ErrMsg2 ) ! x + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL ADI_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd, ErrStat2, ErrMsg2 ) ! xd + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL ADI_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z, ErrStat2, ErrMsg2 ) ! z + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL ADI_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherState, ErrStat2, ErrMsg2 ) ! OtherState + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL ADI_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL ADI_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + i1_l = LBOUND(OutData%u,1) + i1_u = UBOUND(OutData%u,1) + DO i1 = LBOUND(OutData%u,1), UBOUND(OutData%u,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL ADI_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u(i1), ErrStat2, ErrMsg2 ) ! u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL ADI_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + i1_l = LBOUND(OutData%inputTimes,1) + i1_u = UBOUND(OutData%inputTimes,1) + DO i1 = LBOUND(OutData%inputTimes,1), UBOUND(OutData%inputTimes,1) + OutData%inputTimes(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END SUBROUTINE ADI_UnPackData + + SUBROUTINE ADI_CopyRotFED( SrcRotFEDData, DstRotFEDData, CtrlCode, ErrStat, ErrMsg ) + TYPE(RotFED), INTENT(INOUT) :: SrcRotFEDData + TYPE(RotFED), INTENT(INOUT) :: DstRotFEDData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ADI_CopyRotFED' +! + ErrStat = ErrID_None + ErrMsg = "" + CALL MeshCopy( SrcRotFEDData%PlatformPtMesh, DstRotFEDData%PlatformPtMesh, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL MeshCopy( SrcRotFEDData%TwrPtMesh, DstRotFEDData%TwrPtMesh, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL MeshCopy( SrcRotFEDData%TwrPtMeshAD, DstRotFEDData%TwrPtMeshAD, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL MeshCopy( SrcRotFEDData%NacelleMotion, DstRotFEDData%NacelleMotion, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL MeshCopy( SrcRotFEDData%HubPtMotion, DstRotFEDData%HubPtMotion, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcRotFEDData%BladeRootMotion)) THEN + i1_l = LBOUND(SrcRotFEDData%BladeRootMotion,1) + i1_u = UBOUND(SrcRotFEDData%BladeRootMotion,1) + IF (.NOT. ALLOCATED(DstRotFEDData%BladeRootMotion)) THEN + ALLOCATE(DstRotFEDData%BladeRootMotion(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotFEDData%BladeRootMotion.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcRotFEDData%BladeRootMotion,1), UBOUND(SrcRotFEDData%BladeRootMotion,1) + CALL MeshCopy( SrcRotFEDData%BladeRootMotion(i1), DstRotFEDData%BladeRootMotion(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcRotFEDData%BladeLn2Mesh)) THEN + i1_l = LBOUND(SrcRotFEDData%BladeLn2Mesh,1) + i1_u = UBOUND(SrcRotFEDData%BladeLn2Mesh,1) + IF (.NOT. ALLOCATED(DstRotFEDData%BladeLn2Mesh)) THEN + ALLOCATE(DstRotFEDData%BladeLn2Mesh(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotFEDData%BladeLn2Mesh.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcRotFEDData%BladeLn2Mesh,1), UBOUND(SrcRotFEDData%BladeLn2Mesh,1) + CALL MeshCopy( SrcRotFEDData%BladeLn2Mesh(i1), DstRotFEDData%BladeLn2Mesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF + DstRotFEDData%hasTower = SrcRotFEDData%hasTower + DstRotFEDData%rigidBlades = SrcRotFEDData%rigidBlades + DstRotFEDData%numBlades = SrcRotFEDData%numBlades + CALL NWTC_Library_Copymeshmaptype( SrcRotFEDData%ED_P_2_AD_P_T, DstRotFEDData%ED_P_2_AD_P_T, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL NWTC_Library_Copymeshmaptype( SrcRotFEDData%AD_P_2_AD_L_T, DstRotFEDData%AD_P_2_AD_L_T, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcRotFEDData%AD_P_2_AD_L_B)) THEN + i1_l = LBOUND(SrcRotFEDData%AD_P_2_AD_L_B,1) + i1_u = UBOUND(SrcRotFEDData%AD_P_2_AD_L_B,1) + IF (.NOT. ALLOCATED(DstRotFEDData%AD_P_2_AD_L_B)) THEN + ALLOCATE(DstRotFEDData%AD_P_2_AD_L_B(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotFEDData%AD_P_2_AD_L_B.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcRotFEDData%AD_P_2_AD_L_B,1), UBOUND(SrcRotFEDData%AD_P_2_AD_L_B,1) + CALL NWTC_Library_Copymeshmaptype( SrcRotFEDData%AD_P_2_AD_L_B(i1), DstRotFEDData%AD_P_2_AD_L_B(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF + CALL NWTC_Library_Copymeshmaptype( SrcRotFEDData%ED_P_2_AD_P_TF, DstRotFEDData%ED_P_2_AD_P_TF, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcRotFEDData%ED_P_2_AD_P_R)) THEN + i1_l = LBOUND(SrcRotFEDData%ED_P_2_AD_P_R,1) + i1_u = UBOUND(SrcRotFEDData%ED_P_2_AD_P_R,1) + IF (.NOT. ALLOCATED(DstRotFEDData%ED_P_2_AD_P_R)) THEN + ALLOCATE(DstRotFEDData%ED_P_2_AD_P_R(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotFEDData%ED_P_2_AD_P_R.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcRotFEDData%ED_P_2_AD_P_R,1), UBOUND(SrcRotFEDData%ED_P_2_AD_P_R,1) + CALL NWTC_Library_Copymeshmaptype( SrcRotFEDData%ED_P_2_AD_P_R(i1), DstRotFEDData%ED_P_2_AD_P_R(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF + CALL NWTC_Library_Copymeshmaptype( SrcRotFEDData%ED_P_2_AD_P_H, DstRotFEDData%ED_P_2_AD_P_H, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL NWTC_Library_Copymeshmaptype( SrcRotFEDData%ED_P_2_AD_P_N, DstRotFEDData%ED_P_2_AD_P_N, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + END SUBROUTINE ADI_CopyRotFED + + SUBROUTINE ADI_DestroyRotFED( RotFEDData, ErrStat, ErrMsg, DEALLOCATEpointers ) + TYPE(RotFED), INTENT(INOUT) :: RotFEDData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + LOGICAL :: DEALLOCATEpointers_local + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ADI_DestroyRotFED' + + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + + CALL MeshDestroy( RotFEDData%PlatformPtMesh, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL MeshDestroy( RotFEDData%TwrPtMesh, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL MeshDestroy( RotFEDData%TwrPtMeshAD, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL MeshDestroy( RotFEDData%NacelleMotion, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL MeshDestroy( RotFEDData%HubPtMotion, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +IF (ALLOCATED(RotFEDData%BladeRootMotion)) THEN +DO i1 = LBOUND(RotFEDData%BladeRootMotion,1), UBOUND(RotFEDData%BladeRootMotion,1) + CALL MeshDestroy( RotFEDData%BladeRootMotion(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(RotFEDData%BladeRootMotion) +ENDIF +IF (ALLOCATED(RotFEDData%BladeLn2Mesh)) THEN +DO i1 = LBOUND(RotFEDData%BladeLn2Mesh,1), UBOUND(RotFEDData%BladeLn2Mesh,1) + CALL MeshDestroy( RotFEDData%BladeLn2Mesh(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(RotFEDData%BladeLn2Mesh) +ENDIF + CALL NWTC_Library_Destroymeshmaptype( RotFEDData%ED_P_2_AD_P_T, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL NWTC_Library_Destroymeshmaptype( RotFEDData%AD_P_2_AD_L_T, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +IF (ALLOCATED(RotFEDData%AD_P_2_AD_L_B)) THEN +DO i1 = LBOUND(RotFEDData%AD_P_2_AD_L_B,1), UBOUND(RotFEDData%AD_P_2_AD_L_B,1) + CALL NWTC_Library_Destroymeshmaptype( RotFEDData%AD_P_2_AD_L_B(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(RotFEDData%AD_P_2_AD_L_B) +ENDIF + CALL NWTC_Library_Destroymeshmaptype( RotFEDData%ED_P_2_AD_P_TF, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +IF (ALLOCATED(RotFEDData%ED_P_2_AD_P_R)) THEN +DO i1 = LBOUND(RotFEDData%ED_P_2_AD_P_R,1), UBOUND(RotFEDData%ED_P_2_AD_P_R,1) + CALL NWTC_Library_Destroymeshmaptype( RotFEDData%ED_P_2_AD_P_R(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(RotFEDData%ED_P_2_AD_P_R) +ENDIF + CALL NWTC_Library_Destroymeshmaptype( RotFEDData%ED_P_2_AD_P_H, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL NWTC_Library_Destroymeshmaptype( RotFEDData%ED_P_2_AD_P_N, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + END SUBROUTINE ADI_DestroyRotFED + + SUBROUTINE ADI_PackRotFED( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(RotFED), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ADI_PackRotFED' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + Int_BufSz = Int_BufSz + 3 ! PlatformPtMesh: size of buffers for each call to pack subtype + CALL MeshPack( InData%PlatformPtMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! PlatformPtMesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! PlatformPtMesh + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! PlatformPtMesh + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! PlatformPtMesh + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! TwrPtMesh: size of buffers for each call to pack subtype + CALL MeshPack( InData%TwrPtMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! TwrPtMesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! TwrPtMesh + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! TwrPtMesh + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! TwrPtMesh + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! TwrPtMeshAD: size of buffers for each call to pack subtype + CALL MeshPack( InData%TwrPtMeshAD, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! TwrPtMeshAD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! TwrPtMeshAD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! TwrPtMeshAD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! TwrPtMeshAD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! NacelleMotion: size of buffers for each call to pack subtype + CALL MeshPack( InData%NacelleMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! NacelleMotion + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! NacelleMotion + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! NacelleMotion + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! NacelleMotion + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! HubPtMotion: size of buffers for each call to pack subtype + CALL MeshPack( InData%HubPtMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! HubPtMotion + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! HubPtMotion + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! HubPtMotion + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! HubPtMotion + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 1 ! BladeRootMotion allocated yes/no + IF ( ALLOCATED(InData%BladeRootMotion) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! BladeRootMotion upper/lower bounds for each dimension + DO i1 = LBOUND(InData%BladeRootMotion,1), UBOUND(InData%BladeRootMotion,1) + Int_BufSz = Int_BufSz + 3 ! BladeRootMotion: size of buffers for each call to pack subtype + CALL MeshPack( InData%BladeRootMotion(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! BladeRootMotion + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! BladeRootMotion + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! BladeRootMotion + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! BladeRootMotion + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! BladeLn2Mesh allocated yes/no + IF ( ALLOCATED(InData%BladeLn2Mesh) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! BladeLn2Mesh upper/lower bounds for each dimension + DO i1 = LBOUND(InData%BladeLn2Mesh,1), UBOUND(InData%BladeLn2Mesh,1) + Int_BufSz = Int_BufSz + 3 ! BladeLn2Mesh: size of buffers for each call to pack subtype + CALL MeshPack( InData%BladeLn2Mesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! BladeLn2Mesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! BladeLn2Mesh + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! BladeLn2Mesh + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! BladeLn2Mesh + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! hasTower + Int_BufSz = Int_BufSz + 1 ! rigidBlades + Int_BufSz = Int_BufSz + 1 ! numBlades + Int_BufSz = Int_BufSz + 3 ! ED_P_2_AD_P_T: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_T, ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_AD_P_T + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_AD_P_T + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_AD_P_T + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_AD_P_T + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! AD_P_2_AD_L_T: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%AD_P_2_AD_L_T, ErrStat2, ErrMsg2, .TRUE. ) ! AD_P_2_AD_L_T + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! AD_P_2_AD_L_T + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! AD_P_2_AD_L_T + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! AD_P_2_AD_L_T + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 1 ! AD_P_2_AD_L_B allocated yes/no + IF ( ALLOCATED(InData%AD_P_2_AD_L_B) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! AD_P_2_AD_L_B upper/lower bounds for each dimension + DO i1 = LBOUND(InData%AD_P_2_AD_L_B,1), UBOUND(InData%AD_P_2_AD_L_B,1) + Int_BufSz = Int_BufSz + 3 ! AD_P_2_AD_L_B: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%AD_P_2_AD_L_B(i1), ErrStat2, ErrMsg2, .TRUE. ) ! AD_P_2_AD_L_B + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! AD_P_2_AD_L_B + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! AD_P_2_AD_L_B + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! AD_P_2_AD_L_B + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 3 ! ED_P_2_AD_P_TF: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_TF, ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_AD_P_TF + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_AD_P_TF + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_AD_P_TF + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_AD_P_TF + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 1 ! ED_P_2_AD_P_R allocated yes/no + IF ( ALLOCATED(InData%ED_P_2_AD_P_R) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! ED_P_2_AD_P_R upper/lower bounds for each dimension + DO i1 = LBOUND(InData%ED_P_2_AD_P_R,1), UBOUND(InData%ED_P_2_AD_P_R,1) + Int_BufSz = Int_BufSz + 3 ! ED_P_2_AD_P_R: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_R(i1), ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_AD_P_R + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_AD_P_R + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_AD_P_R + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_AD_P_R + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 3 ! ED_P_2_AD_P_H: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_H, ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_AD_P_H + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_AD_P_H + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_AD_P_H + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_AD_P_H + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! ED_P_2_AD_P_N: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_N, ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_AD_P_N + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_AD_P_N + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_AD_P_N + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_AD_P_N + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + CALL MeshPack( InData%PlatformPtMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! PlatformPtMesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL MeshPack( InData%TwrPtMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! TwrPtMesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL MeshPack( InData%TwrPtMeshAD, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! TwrPtMeshAD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL MeshPack( InData%NacelleMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! NacelleMotion + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL MeshPack( InData%HubPtMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! HubPtMotion + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF ( .NOT. ALLOCATED(InData%BladeRootMotion) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BladeRootMotion,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeRootMotion,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%BladeRootMotion,1), UBOUND(InData%BladeRootMotion,1) + CALL MeshPack( InData%BladeRootMotion(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! BladeRootMotion + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%BladeLn2Mesh) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BladeLn2Mesh,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeLn2Mesh,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%BladeLn2Mesh,1), UBOUND(InData%BladeLn2Mesh,1) + CALL MeshPack( InData%BladeLn2Mesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! BladeLn2Mesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IntKiBuf(Int_Xferred) = TRANSFER(InData%hasTower, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%rigidBlades, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%numBlades + Int_Xferred = Int_Xferred + 1 + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_T, ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_AD_P_T + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%AD_P_2_AD_L_T, ErrStat2, ErrMsg2, OnlySize ) ! AD_P_2_AD_L_T + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF ( .NOT. ALLOCATED(InData%AD_P_2_AD_L_B) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%AD_P_2_AD_L_B,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AD_P_2_AD_L_B,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%AD_P_2_AD_L_B,1), UBOUND(InData%AD_P_2_AD_L_B,1) + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%AD_P_2_AD_L_B(i1), ErrStat2, ErrMsg2, OnlySize ) ! AD_P_2_AD_L_B + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_TF, ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_AD_P_TF + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF ( .NOT. ALLOCATED(InData%ED_P_2_AD_P_R) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%ED_P_2_AD_P_R,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ED_P_2_AD_P_R,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%ED_P_2_AD_P_R,1), UBOUND(InData%ED_P_2_AD_P_R,1) + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_R(i1), ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_AD_P_R + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_H, ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_AD_P_H + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_N, ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_AD_P_N + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END SUBROUTINE ADI_PackRotFED + + SUBROUTINE ADI_UnPackRotFED( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(RotFED), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ADI_UnPackRotFED' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MeshUnpack( OutData%PlatformPtMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! PlatformPtMesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MeshUnpack( OutData%TwrPtMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! TwrPtMesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MeshUnpack( OutData%TwrPtMeshAD, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! TwrPtMeshAD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MeshUnpack( OutData%NacelleMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! NacelleMotion + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MeshUnpack( OutData%HubPtMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! HubPtMotion + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BladeRootMotion not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BladeRootMotion)) DEALLOCATE(OutData%BladeRootMotion) + ALLOCATE(OutData%BladeRootMotion(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeRootMotion.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%BladeRootMotion,1), UBOUND(OutData%BladeRootMotion,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MeshUnpack( OutData%BladeRootMotion(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! BladeRootMotion + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BladeLn2Mesh not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BladeLn2Mesh)) DEALLOCATE(OutData%BladeLn2Mesh) + ALLOCATE(OutData%BladeLn2Mesh(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeLn2Mesh.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%BladeLn2Mesh,1), UBOUND(OutData%BladeLn2Mesh,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MeshUnpack( OutData%BladeLn2Mesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! BladeLn2Mesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + OutData%hasTower = TRANSFER(IntKiBuf(Int_Xferred), OutData%hasTower) + Int_Xferred = Int_Xferred + 1 + OutData%rigidBlades = TRANSFER(IntKiBuf(Int_Xferred), OutData%rigidBlades) + Int_Xferred = Int_Xferred + 1 + OutData%numBlades = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_AD_P_T, ErrStat2, ErrMsg2 ) ! ED_P_2_AD_P_T + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%AD_P_2_AD_L_T, ErrStat2, ErrMsg2 ) ! AD_P_2_AD_L_T + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AD_P_2_AD_L_B not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%AD_P_2_AD_L_B)) DEALLOCATE(OutData%AD_P_2_AD_L_B) + ALLOCATE(OutData%AD_P_2_AD_L_B(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AD_P_2_AD_L_B.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%AD_P_2_AD_L_B,1), UBOUND(OutData%AD_P_2_AD_L_B,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%AD_P_2_AD_L_B(i1), ErrStat2, ErrMsg2 ) ! AD_P_2_AD_L_B + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_AD_P_TF, ErrStat2, ErrMsg2 ) ! ED_P_2_AD_P_TF + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ED_P_2_AD_P_R not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%ED_P_2_AD_P_R)) DEALLOCATE(OutData%ED_P_2_AD_P_R) + ALLOCATE(OutData%ED_P_2_AD_P_R(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ED_P_2_AD_P_R.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%ED_P_2_AD_P_R,1), UBOUND(OutData%ED_P_2_AD_P_R,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_AD_P_R(i1), ErrStat2, ErrMsg2 ) ! ED_P_2_AD_P_R + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_AD_P_H, ErrStat2, ErrMsg2 ) ! ED_P_2_AD_P_H + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_AD_P_N, ErrStat2, ErrMsg2 ) ! ED_P_2_AD_P_N + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END SUBROUTINE ADI_UnPackRotFED + + SUBROUTINE ADI_CopyFED_Data( SrcFED_DataData, DstFED_DataData, CtrlCode, ErrStat, ErrMsg ) + TYPE(FED_Data), INTENT(INOUT) :: SrcFED_DataData + TYPE(FED_Data), INTENT(INOUT) :: DstFED_DataData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ADI_CopyFED_Data' +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(SrcFED_DataData%WT)) THEN + i1_l = LBOUND(SrcFED_DataData%WT,1) + i1_u = UBOUND(SrcFED_DataData%WT,1) + IF (.NOT. ALLOCATED(DstFED_DataData%WT)) THEN + ALLOCATE(DstFED_DataData%WT(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstFED_DataData%WT.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcFED_DataData%WT,1), UBOUND(SrcFED_DataData%WT,1) + CALL ADI_Copyrotfed( SrcFED_DataData%WT(i1), DstFED_DataData%WT(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF + END SUBROUTINE ADI_CopyFED_Data + + SUBROUTINE ADI_DestroyFED_Data( FED_DataData, ErrStat, ErrMsg, DEALLOCATEpointers ) + TYPE(FED_Data), INTENT(INOUT) :: FED_DataData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + LOGICAL :: DEALLOCATEpointers_local + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ADI_DestroyFED_Data' + + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + +IF (ALLOCATED(FED_DataData%WT)) THEN +DO i1 = LBOUND(FED_DataData%WT,1), UBOUND(FED_DataData%WT,1) + CALL ADI_Destroyrotfed( FED_DataData%WT(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(FED_DataData%WT) +ENDIF + END SUBROUTINE ADI_DestroyFED_Data + + SUBROUTINE ADI_PackFED_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(FED_Data), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ADI_PackFED_Data' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1 ! WT allocated yes/no + IF ( ALLOCATED(InData%WT) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! WT upper/lower bounds for each dimension + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + DO i1 = LBOUND(InData%WT,1), UBOUND(InData%WT,1) + Int_BufSz = Int_BufSz + 3 ! WT: size of buffers for each call to pack subtype + CALL ADI_Packrotfed( Re_Buf, Db_Buf, Int_Buf, InData%WT(i1), ErrStat2, ErrMsg2, .TRUE. ) ! WT + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! WT + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! WT + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! WT + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + IF ( .NOT. ALLOCATED(InData%WT) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WT,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WT,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%WT,1), UBOUND(InData%WT,1) + CALL ADI_Packrotfed( Re_Buf, Db_Buf, Int_Buf, InData%WT(i1), ErrStat2, ErrMsg2, OnlySize ) ! WT + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + END SUBROUTINE ADI_PackFED_Data + + SUBROUTINE ADI_UnPackFED_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(FED_Data), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ADI_UnPackFED_Data' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WT not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WT)) DEALLOCATE(OutData%WT) + ALLOCATE(OutData%WT(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WT.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%WT,1), UBOUND(OutData%WT,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL ADI_Unpackrotfed( Re_Buf, Db_Buf, Int_Buf, OutData%WT(i1), ErrStat2, ErrMsg2 ) ! WT + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + END SUBROUTINE ADI_UnPackFED_Data + + + SUBROUTINE ADI_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(ADI_InputType), INTENT(INOUT) :: u(:) ! Input at t1 > t2 > t3 + REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs + TYPE(ADI_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 = 'ADI_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 ADI_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + ELSE IF ( order .eq. 1 ) THEN + CALL ADI_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 ADI_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 ADI_Input_ExtrapInterp + + + SUBROUTINE ADI_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(ADI_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 + TYPE(ADI_InputType), INTENT(INOUT) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(ADI_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 = 'ADI_Input_ExtrapInterp1' + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF ( EqualRealNos( t(1), t(2) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + + ScaleFactor = t_out / t(2) + CALL AD_Input_ExtrapInterp1( u1%AD, u2%AD, tin, u_out%AD, tin_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END SUBROUTINE ADI_Input_ExtrapInterp1 + + + SUBROUTINE ADI_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(ADI_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 + TYPE(ADI_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 + TYPE(ADI_InputType), INTENT(INOUT) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(ADI_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 = 'ADI_Input_ExtrapInterp2' + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF ( EqualRealNos( t(1), t(2) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) + CALL AD_Input_ExtrapInterp2( u1%AD, u2%AD, u3%AD, tin, u_out%AD, tin_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END SUBROUTINE ADI_Input_ExtrapInterp2 + + + SUBROUTINE ADI_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(ADI_OutputType), INTENT(INOUT) :: y(:) ! Output at t1 > t2 > t3 + REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs + TYPE(ADI_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 = 'ADI_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 ADI_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + ELSE IF ( order .eq. 1 ) THEN + CALL ADI_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 ADI_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 ADI_Output_ExtrapInterp + + + SUBROUTINE ADI_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(ADI_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 + TYPE(ADI_OutputType), INTENT(INOUT) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(ADI_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 = 'ADI_Output_ExtrapInterp1' + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF ( EqualRealNos( t(1), t(2) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + + ScaleFactor = t_out / t(2) + CALL AD_Output_ExtrapInterp1( y1%AD, y2%AD, tin, y_out%AD, tin_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +IF (ALLOCATED(y_out%HHVel) .AND. ALLOCATED(y1%HHVel)) THEN + DO i2 = LBOUND(y_out%HHVel,2),UBOUND(y_out%HHVel,2) + DO i1 = LBOUND(y_out%HHVel,1),UBOUND(y_out%HHVel,1) + b = -(y1%HHVel(i1,i2) - y2%HHVel(i1,i2)) + y_out%HHVel(i1,i2) = y1%HHVel(i1,i2) + b * ScaleFactor + END DO + END DO +END IF ! check if allocated + b = -(y1%PLExp - y2%PLExp) + y_out%PLExp = y1%PLExp + b * ScaleFactor +IF (ALLOCATED(y_out%IW_WriteOutput) .AND. ALLOCATED(y1%IW_WriteOutput)) THEN + DO i1 = LBOUND(y_out%IW_WriteOutput,1),UBOUND(y_out%IW_WriteOutput,1) + b = -(y1%IW_WriteOutput(i1) - y2%IW_WriteOutput(i1)) + y_out%IW_WriteOutput(i1) = y1%IW_WriteOutput(i1) + b * ScaleFactor + END DO +END IF ! check if allocated +IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor + END DO +END IF ! check if allocated + END SUBROUTINE ADI_Output_ExtrapInterp1 + + + SUBROUTINE ADI_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(ADI_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 + TYPE(ADI_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 + TYPE(ADI_OutputType), INTENT(INOUT) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(ADI_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 = 'ADI_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF ( EqualRealNos( t(1), t(2) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + 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 AD_Output_ExtrapInterp2( y1%AD, y2%AD, y3%AD, tin, y_out%AD, tin_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +IF (ALLOCATED(y_out%HHVel) .AND. ALLOCATED(y1%HHVel)) THEN + DO i2 = LBOUND(y_out%HHVel,2),UBOUND(y_out%HHVel,2) + DO i1 = LBOUND(y_out%HHVel,1),UBOUND(y_out%HHVel,1) + b = (t(3)**2*(y1%HHVel(i1,i2) - y2%HHVel(i1,i2)) + t(2)**2*(-y1%HHVel(i1,i2) + y3%HHVel(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*y1%HHVel(i1,i2) + t(3)*y2%HHVel(i1,i2) - t(2)*y3%HHVel(i1,i2) ) * scaleFactor + y_out%HHVel(i1,i2) = y1%HHVel(i1,i2) + b + c * t_out + END DO + END DO +END IF ! check if allocated + b = (t(3)**2*(y1%PLExp - y2%PLExp) + t(2)**2*(-y1%PLExp + y3%PLExp))* scaleFactor + c = ( (t(2)-t(3))*y1%PLExp + t(3)*y2%PLExp - t(2)*y3%PLExp ) * scaleFactor + y_out%PLExp = y1%PLExp + b + c * t_out +IF (ALLOCATED(y_out%IW_WriteOutput) .AND. ALLOCATED(y1%IW_WriteOutput)) THEN + DO i1 = LBOUND(y_out%IW_WriteOutput,1),UBOUND(y_out%IW_WriteOutput,1) + b = (t(3)**2*(y1%IW_WriteOutput(i1) - y2%IW_WriteOutput(i1)) + t(2)**2*(-y1%IW_WriteOutput(i1) + y3%IW_WriteOutput(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%IW_WriteOutput(i1) + t(3)*y2%IW_WriteOutput(i1) - t(2)*y3%IW_WriteOutput(i1) ) * scaleFactor + y_out%IW_WriteOutput(i1) = y1%IW_WriteOutput(i1) + b + c * t_out + END DO +END IF ! check if allocated +IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out + END DO +END IF ! check if allocated + END SUBROUTINE ADI_Output_ExtrapInterp2 + +END MODULE AeroDyn_Inflow_Types +!ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn/src/AeroDyn_Registry.txt b/modules/aerodyn/src/AeroDyn_Registry.txt index 28cf53be76..64c95d2edc 100644 --- a/modules/aerodyn/src/AeroDyn_Registry.txt +++ b/modules/aerodyn/src/AeroDyn_Registry.txt @@ -65,6 +65,14 @@ typedef ^ TFinInputFileType IntKi TFinIndMod - - - "Model for induced typedef ^ TFinInputFileType IntKi TFinAFID - - - "Index of Tail fin airfoil number [1 to NumAFfiles]" - + +typedef ^ AD_VTK_BLSurfaceType SiKi AirfoilCoords {:}{:}{:} - - "x,y coordinates for airfoil around each blade node on a blade (relative to reference)" - + +typedef ^ AD_VTK_RotSurfaceType AD_VTK_BLSurfaceType BladeShape {:} - - "AirfoilCoords for each blade" - +typedef ^ ^ SiKi TowerRad {:} - - "radius of each ED tower node" m + + + # ..... Initialization data ....................................................................................................... # Define inputs that the initialization routine may need here: typedef AeroDyn/AD RotInitInputType IntKi NumBlades - - - "Number of blades on the turbine" - diff --git a/modules/aerodyn/src/AeroDyn_Types.f90 b/modules/aerodyn/src/AeroDyn_Types.f90 index da26f5ddbc..86225aa386 100644 --- a/modules/aerodyn/src/AeroDyn_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Types.f90 @@ -79,6 +79,17 @@ MODULE AeroDyn_Types INTEGER(IntKi) :: TFinAFID !< Index of Tail fin airfoil number [1 to NumAFfiles] [-] END TYPE TFinInputFileType ! ======================= +! ========= AD_VTK_BLSurfaceType ======= + TYPE, PUBLIC :: AD_VTK_BLSurfaceType + REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: AirfoilCoords !< x,y coordinates for airfoil around each blade node on a blade (relative to reference) [-] + END TYPE AD_VTK_BLSurfaceType +! ======================= +! ========= AD_VTK_RotSurfaceType ======= + TYPE, PUBLIC :: AD_VTK_RotSurfaceType + TYPE(AD_VTK_BLSurfaceType) , DIMENSION(:), ALLOCATABLE :: BladeShape !< AirfoilCoords for each blade [-] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: TowerRad !< radius of each ED tower node [m] + END TYPE AD_VTK_RotSurfaceType +! ======================= ! ========= RotInitInputType ======= TYPE, PUBLIC :: RotInitInputType INTEGER(IntKi) :: NumBlades !< Number of blades on the turbine [-] @@ -821,6 +832,550 @@ SUBROUTINE AD_UnPackTFinInputFileType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS Int_Xferred = Int_Xferred + 1 END SUBROUTINE AD_UnPackTFinInputFileType + SUBROUTINE AD_CopyVTK_BLSurfaceType( SrcVTK_BLSurfaceTypeData, DstVTK_BLSurfaceTypeData, CtrlCode, ErrStat, ErrMsg ) + TYPE(AD_VTK_BLSurfaceType), INTENT(IN) :: SrcVTK_BLSurfaceTypeData + TYPE(AD_VTK_BLSurfaceType), INTENT(INOUT) :: DstVTK_BLSurfaceTypeData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AD_CopyVTK_BLSurfaceType' +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(SrcVTK_BLSurfaceTypeData%AirfoilCoords)) THEN + i1_l = LBOUND(SrcVTK_BLSurfaceTypeData%AirfoilCoords,1) + i1_u = UBOUND(SrcVTK_BLSurfaceTypeData%AirfoilCoords,1) + i2_l = LBOUND(SrcVTK_BLSurfaceTypeData%AirfoilCoords,2) + i2_u = UBOUND(SrcVTK_BLSurfaceTypeData%AirfoilCoords,2) + i3_l = LBOUND(SrcVTK_BLSurfaceTypeData%AirfoilCoords,3) + i3_u = UBOUND(SrcVTK_BLSurfaceTypeData%AirfoilCoords,3) + IF (.NOT. ALLOCATED(DstVTK_BLSurfaceTypeData%AirfoilCoords)) THEN + ALLOCATE(DstVTK_BLSurfaceTypeData%AirfoilCoords(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_BLSurfaceTypeData%AirfoilCoords.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstVTK_BLSurfaceTypeData%AirfoilCoords = SrcVTK_BLSurfaceTypeData%AirfoilCoords +ENDIF + END SUBROUTINE AD_CopyVTK_BLSurfaceType + + SUBROUTINE AD_DestroyVTK_BLSurfaceType( VTK_BLSurfaceTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + TYPE(AD_VTK_BLSurfaceType), INTENT(INOUT) :: VTK_BLSurfaceTypeData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + LOGICAL :: DEALLOCATEpointers_local + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyVTK_BLSurfaceType' + + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + +IF (ALLOCATED(VTK_BLSurfaceTypeData%AirfoilCoords)) THEN + DEALLOCATE(VTK_BLSurfaceTypeData%AirfoilCoords) +ENDIF + END SUBROUTINE AD_DestroyVTK_BLSurfaceType + + SUBROUTINE AD_PackVTK_BLSurfaceType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(AD_VTK_BLSurfaceType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AD_PackVTK_BLSurfaceType' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1 ! AirfoilCoords allocated yes/no + IF ( ALLOCATED(InData%AirfoilCoords) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! AirfoilCoords upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%AirfoilCoords) ! AirfoilCoords + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + IF ( .NOT. ALLOCATED(InData%AirfoilCoords) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%AirfoilCoords,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AirfoilCoords,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%AirfoilCoords,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AirfoilCoords,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%AirfoilCoords,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AirfoilCoords,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%AirfoilCoords,3), UBOUND(InData%AirfoilCoords,3) + DO i2 = LBOUND(InData%AirfoilCoords,2), UBOUND(InData%AirfoilCoords,2) + DO i1 = LBOUND(InData%AirfoilCoords,1), UBOUND(InData%AirfoilCoords,1) + ReKiBuf(Re_Xferred) = InData%AirfoilCoords(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + END SUBROUTINE AD_PackVTK_BLSurfaceType + + SUBROUTINE AD_UnPackVTK_BLSurfaceType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(AD_VTK_BLSurfaceType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AD_UnPackVTK_BLSurfaceType' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AirfoilCoords not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%AirfoilCoords)) DEALLOCATE(OutData%AirfoilCoords) + ALLOCATE(OutData%AirfoilCoords(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AirfoilCoords.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%AirfoilCoords,3), UBOUND(OutData%AirfoilCoords,3) + DO i2 = LBOUND(OutData%AirfoilCoords,2), UBOUND(OutData%AirfoilCoords,2) + DO i1 = LBOUND(OutData%AirfoilCoords,1), UBOUND(OutData%AirfoilCoords,1) + OutData%AirfoilCoords(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + END SUBROUTINE AD_UnPackVTK_BLSurfaceType + + SUBROUTINE AD_CopyVTK_RotSurfaceType( SrcVTK_RotSurfaceTypeData, DstVTK_RotSurfaceTypeData, CtrlCode, ErrStat, ErrMsg ) + TYPE(AD_VTK_RotSurfaceType), INTENT(IN) :: SrcVTK_RotSurfaceTypeData + TYPE(AD_VTK_RotSurfaceType), INTENT(INOUT) :: DstVTK_RotSurfaceTypeData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AD_CopyVTK_RotSurfaceType' +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(SrcVTK_RotSurfaceTypeData%BladeShape)) THEN + i1_l = LBOUND(SrcVTK_RotSurfaceTypeData%BladeShape,1) + i1_u = UBOUND(SrcVTK_RotSurfaceTypeData%BladeShape,1) + IF (.NOT. ALLOCATED(DstVTK_RotSurfaceTypeData%BladeShape)) THEN + ALLOCATE(DstVTK_RotSurfaceTypeData%BladeShape(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_RotSurfaceTypeData%BladeShape.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcVTK_RotSurfaceTypeData%BladeShape,1), UBOUND(SrcVTK_RotSurfaceTypeData%BladeShape,1) + CALL AD_Copyvtk_blsurfacetype( SrcVTK_RotSurfaceTypeData%BladeShape(i1), DstVTK_RotSurfaceTypeData%BladeShape(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcVTK_RotSurfaceTypeData%TowerRad)) THEN + i1_l = LBOUND(SrcVTK_RotSurfaceTypeData%TowerRad,1) + i1_u = UBOUND(SrcVTK_RotSurfaceTypeData%TowerRad,1) + IF (.NOT. ALLOCATED(DstVTK_RotSurfaceTypeData%TowerRad)) THEN + ALLOCATE(DstVTK_RotSurfaceTypeData%TowerRad(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_RotSurfaceTypeData%TowerRad.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstVTK_RotSurfaceTypeData%TowerRad = SrcVTK_RotSurfaceTypeData%TowerRad +ENDIF + END SUBROUTINE AD_CopyVTK_RotSurfaceType + + SUBROUTINE AD_DestroyVTK_RotSurfaceType( VTK_RotSurfaceTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + TYPE(AD_VTK_RotSurfaceType), INTENT(INOUT) :: VTK_RotSurfaceTypeData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + LOGICAL :: DEALLOCATEpointers_local + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyVTK_RotSurfaceType' + + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + +IF (ALLOCATED(VTK_RotSurfaceTypeData%BladeShape)) THEN +DO i1 = LBOUND(VTK_RotSurfaceTypeData%BladeShape,1), UBOUND(VTK_RotSurfaceTypeData%BladeShape,1) + CALL AD_Destroyvtk_blsurfacetype( VTK_RotSurfaceTypeData%BladeShape(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(VTK_RotSurfaceTypeData%BladeShape) +ENDIF +IF (ALLOCATED(VTK_RotSurfaceTypeData%TowerRad)) THEN + DEALLOCATE(VTK_RotSurfaceTypeData%TowerRad) +ENDIF + END SUBROUTINE AD_DestroyVTK_RotSurfaceType + + SUBROUTINE AD_PackVTK_RotSurfaceType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(AD_VTK_RotSurfaceType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AD_PackVTK_RotSurfaceType' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1 ! BladeShape allocated yes/no + IF ( ALLOCATED(InData%BladeShape) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! BladeShape upper/lower bounds for each dimension + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + DO i1 = LBOUND(InData%BladeShape,1), UBOUND(InData%BladeShape,1) + Int_BufSz = Int_BufSz + 3 ! BladeShape: size of buffers for each call to pack subtype + CALL AD_Packvtk_blsurfacetype( Re_Buf, Db_Buf, Int_Buf, InData%BladeShape(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BladeShape + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! BladeShape + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! BladeShape + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! BladeShape + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! TowerRad allocated yes/no + IF ( ALLOCATED(InData%TowerRad) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! TowerRad upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%TowerRad) ! TowerRad + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + IF ( .NOT. ALLOCATED(InData%BladeShape) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BladeShape,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeShape,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%BladeShape,1), UBOUND(InData%BladeShape,1) + CALL AD_Packvtk_blsurfacetype( Re_Buf, Db_Buf, Int_Buf, InData%BladeShape(i1), ErrStat2, ErrMsg2, OnlySize ) ! BladeShape + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%TowerRad) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%TowerRad,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TowerRad,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%TowerRad,1), UBOUND(InData%TowerRad,1) + ReKiBuf(Re_Xferred) = InData%TowerRad(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + END SUBROUTINE AD_PackVTK_RotSurfaceType + + SUBROUTINE AD_UnPackVTK_RotSurfaceType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(AD_VTK_RotSurfaceType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AD_UnPackVTK_RotSurfaceType' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BladeShape not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BladeShape)) DEALLOCATE(OutData%BladeShape) + ALLOCATE(OutData%BladeShape(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeShape.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%BladeShape,1), UBOUND(OutData%BladeShape,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL AD_Unpackvtk_blsurfacetype( Re_Buf, Db_Buf, Int_Buf, OutData%BladeShape(i1), ErrStat2, ErrMsg2 ) ! BladeShape + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TowerRad not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%TowerRad)) DEALLOCATE(OutData%TowerRad) + ALLOCATE(OutData%TowerRad(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TowerRad.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%TowerRad,1), UBOUND(OutData%TowerRad,1) + OutData%TowerRad(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + END SUBROUTINE AD_UnPackVTK_RotSurfaceType + SUBROUTINE AD_CopyRotInitInputType( SrcRotInitInputTypeData, DstRotInitInputTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(RotInitInputType), INTENT(IN) :: SrcRotInitInputTypeData TYPE(RotInitInputType), INTENT(INOUT) :: DstRotInitInputTypeData diff --git a/modules/aerodyn/src/BEMT.f90 b/modules/aerodyn/src/BEMT.f90 index b784109e9a..03e87a9744 100644 --- a/modules/aerodyn/src/BEMT.f90 +++ b/modules/aerodyn/src/BEMT.f90 @@ -174,7 +174,7 @@ subroutine BEMT_SetParameters( InitInp, p, errStat, errMsg ) p%DBEMT_Mod = InitInp%DBEMT_Mod p%MomentumCorr = InitInp%MomentumCorr p%BEM_Mod = InitInp%BEM_Mod - call WrScr('>>>> BEM_Mod '//trim(num2lstr(p%BEM_Mod))) + !call WrScr('>>>> BEM_Mod '//trim(num2lstr(p%BEM_Mod))) if ((p%BEM_Mod/=BEMMod_2D .and. p%BEM_Mod/=BEMMod_3D )) then call SetErrStat( ErrID_Fatal, 'BEM_Mod needs to be 0 or 2 for now', errStat, errMsg, RoutineName ) return diff --git a/modules/elastodyn/src/ElastoDyn_Types.f90 b/modules/elastodyn/src/ElastoDyn_Types.f90 index 8684874eb8..41e564bb9d 100644 --- a/modules/elastodyn/src/ElastoDyn_Types.f90 +++ b/modules/elastodyn/src/ElastoDyn_Types.f90 @@ -235,13 +235,13 @@ MODULE ElastoDyn_Types REAL(ReKi) :: TailFurl !< Initial or fixed tail-furl angle [radians] REAL(ReKi) :: Yaw2Shft !< Lateral distance from the yaw axis to the rotor shaft [meters] REAL(ReKi) :: ShftSkew !< Rotor shaft skew angle [radians] - REAL(ReKi) , DIMENSION(1:3) :: RFrlCM_n !< Downwind distance from tower-top to rotor-furl CM [meters] - REAL(ReKi) , DIMENSION(1:3) :: BoomCM_n !< Downwind distance from tower-top to tail boom CM [meters] - REAL(ReKi) , DIMENSION(1:3) :: TFinCM_n !< Downwind distance from tower-top to tail fin CM [meters] - REAL(ReKi) , DIMENSION(1:3) :: RFrlPnt_n !< Downwind distance from tower-top to arbitrary point on rotor-furl axis [meters] + REAL(ReKi) , DIMENSION(1:3) :: RFrlCM_n !< Vector from tower-top to rotor-furl CM [meters] + REAL(ReKi) , DIMENSION(1:3) :: BoomCM_n !< Vector from tower-top to tail boom CM [meters] + REAL(ReKi) , DIMENSION(1:3) :: TFinCM_n !< Vector from tower-top to tail fin CM [meters] + REAL(ReKi) , DIMENSION(1:3) :: RFrlPnt_n !< Vector from tower-top to arbitrary point on rotor-furl axis [meters] REAL(ReKi) :: RFrlSkew !< Rotor-furl axis skew angle [radians] REAL(ReKi) :: RFrlTilt !< Rotor-furl axis tilt angle [radians] - REAL(ReKi) , DIMENSION(1:3) :: TFrlPnt_n !< Downwind distance from tower-top to arbitrary point on tail-furl axis [meters] + REAL(ReKi) , DIMENSION(1:3) :: TFrlPnt_n !< Vector from tower-top to arbitrary point on tail-furl axis [meters] REAL(ReKi) :: TFrlSkew !< Rotor-furl axis skew angle [radians] REAL(ReKi) :: TFrlTilt !< Rotor-furl axis tilt angle [radians] REAL(ReKi) :: RFrlMass !< Rotor-furl mass [kg] @@ -597,7 +597,7 @@ MODULE ElastoDyn_Types REAL(ReKi) :: ProjArea !< Swept area of the rotor projected onto the rotor plane (the plane normal to the low-speed shaft) [-] REAL(ReKi) :: PtfmRefzt !< Vertical distance from the ground [onshore], MSL [offshore], or seabed [MHK] to the platform reference point [-] REAL(ReKi) :: RefTwrHt !< Vertical distance between FAST's undisplaced tower height (variable TowerHt) and FAST's inertia frame reference point (variable PtfmRef); that is, RefTwrHt = TowerHt - PtfmRefzt [-] - REAL(ReKi) , DIMENSION(1:3) :: RFrlPnt_n !< Position from tower-top to arbitrary point on rotor-furl axis [-] + REAL(ReKi) , DIMENSION(1:3) :: RFrlPnt_n !< Vector from tower-top to arbitrary point on rotor-furl axis [-] REAL(ReKi) :: rVDxn !< xn-component of position vector Rvd [-] REAL(ReKi) :: rVDyn !< yn-component of position vector rVD [-] REAL(ReKi) :: rVDzn !< zn-component of position vector rVD [-] @@ -627,7 +627,7 @@ MODULE ElastoDyn_Types REAL(R8Ki) :: STFrlSkw2 !< Sine-squared of the tail-furl axis skew angle [-] REAL(R8Ki) :: STFrlTilt !< Sine of the tail-furl axis tilt angle [-] REAL(R8Ki) :: STFrlTlt2 !< Sine-squared of the tail-furl axis tilt angle [-] - REAL(ReKi) , DIMENSION(1:3) :: TFrlPnt_n !< Position from tower-top to arbitrary point on tail-furl axis [-] + REAL(ReKi) , DIMENSION(1:3) :: TFrlPnt_n !< Vector from tower-top to arbitrary point on tail-furl axis [-] REAL(ReKi) :: TipRad !< Preconed blade-tip radius [-] REAL(ReKi) :: TowerHt !< Height of tower above ground level [-] REAL(ReKi) :: TowerBsHt !< Height of tower base above ground level [onshore], MSL [offshore], or seabed [MHK] [meters] diff --git a/modules/nwtc-library/src/ModMesh.f90 b/modules/nwtc-library/src/ModMesh.f90 index a9aa606f8d..9b1be7555d 100644 --- a/modules/nwtc-library/src/ModMesh.f90 +++ b/modules/nwtc-library/src/ModMesh.f90 @@ -909,18 +909,23 @@ END SUBROUTINE MeshWrVTK_PointSurface !------------------------------------------------------------------------------------------------------------------------------- !> This routine writes mesh information in text form. It is used for debugging. - SUBROUTINE MeshPrintInfo ( U, M, N) + SUBROUTINE MeshPrintInfo ( U, M, N, MeshName) INTEGER, INTENT(IN ) :: U !< fortran output unit TYPE(MeshType),INTENT(IN ) :: M !< mesh to be reported on INTEGER, OPTIONAL,INTENT(IN ) :: N !< Number to print, default is all nodes + character(*), optional, intent(in ) :: MeshName !< name of the mesh ! Local INTEGER isz,i,j,nn,Ielement,Xelement nn = M%Nnodes !5 IF (PRESENT(N)) nn = min(nn,N) - write(U,*)'----------- MeshPrintInfo: -------------' + if (present(MeshName)) then + write(U,*)'----------- MeshPrintInfo: '//trim(MeshName)//' -------------' + else + write(U,*)'----------- MeshPrintInfo: -------------' + endif write(U,*) 'Initialized: ', M%initialized write(U,*) 'Committed: ', M%Committed diff --git a/modules/nwtc-library/src/NWTC_IO.f90 b/modules/nwtc-library/src/NWTC_IO.f90 index cfd731dddd..5f7f659637 100644 --- a/modules/nwtc-library/src/NWTC_IO.f90 +++ b/modules/nwtc-library/src/NWTC_IO.f90 @@ -218,6 +218,7 @@ MODULE NWTC_IO !> \copydoc nwtc_io::int2lstr INTERFACE Num2LStr MODULE PROCEDURE Int2LStr ! default integers + MODULE PROCEDURE B8Ki2LStr ! 8 byte integers MODULE PROCEDURE R2LStr4 ! 4-byte reals MODULE PROCEDURE R2LStr8 ! 8-byte reals MODULE PROCEDURE R2LStr16 ! 16-byte reals @@ -2559,24 +2560,26 @@ END SUBROUTINE IntAry2Str !! It eliminates trailing zeroes and even the decimal point if it is not a fraction. \n !! Use Num2LStr (nwtc_io::num2lstr) instead of directly calling a specific routine in the generic interface. FUNCTION Int2LStr ( Num ) - - CHARACTER(11) :: Int2LStr !< string representing input number. - - + CHARACTER(11) :: Int2LStr !< string representing input number. ! Argument declarations. - - INTEGER, INTENT(IN) :: Num !< The number to convert to a left-justified string. - - - - WRITE (Int2LStr,'(I11)') Num - - Int2Lstr = ADJUSTL( Int2LStr ) - - - RETURN + INTEGER(IntKi), INTENT(IN) :: Num !< The number to convert to a left-justified string. + WRITE (Int2LStr,'(I11)') Num + Int2Lstr = ADJUSTL( Int2LStr ) + RETURN END FUNCTION Int2LStr !======================================================================= +!> This function returns a left-adjusted string representing the passed numeric value. +!! It eliminates trailing zeroes and even the decimal point if it is not a fraction. \n +!! Use Num2LStr (nwtc_io::num2lstr) instead of directly calling a specific routine in the generic interface. + FUNCTION B8Ki2LStr ( Num ) + CHARACTER(20) :: B8Ki2LStr !< string representing input number. + ! Argument declarations. + INTEGER(B8Ki), INTENT(IN) :: Num !< The number to convert to a left-justified string. + WRITE (B8Ki2LStr,'(I20)') Num + B8Ki2Lstr = ADJUSTL( B8Ki2LStr ) + RETURN + END FUNCTION B8Ki2LStr +!======================================================================= !> This function returns true if and only if the first character of the input StringToCheck matches on the of comment characters !! nwtc_io::commchars. FUNCTION IsComment(StringToCheck) @@ -4505,6 +4508,10 @@ subroutine InitFileInfo_FromNullCString(FileString, FileInfo, ErrStat, ErrMsg) NullLoc = idx endif enddo + ! If the last line is not NULL terminated, might miss the line containing END + if (NullLoc < len_trim(FileString)) then + NumLines = NumLines + 1 + endif if (NumLines == 0) then ErrStat2 = ErrID_Fatal @@ -4531,9 +4538,13 @@ subroutine InitFileInfo_FromNullCString(FileString, FileInfo, ErrStat, ErrMsg) NullLoc = index(FileString(idx:len(FileString)),C_NULL_CHAR) ! started indexing at idx, so add that back in for location in FileString NullLoc = NullLoc + idx - 1 - if (NullLoc > 0) then + if (NullLoc > idx) then FileStringArray(Line) = trim(FileString(idx:NullLoc-1)) else + ! If not NULL terminated + if (len_trim(FileString(NullLoc:len_trim(FileString))) > 0) then + FileStringArray(Line) = trim(FileString(NullLoc+1:len_trim(FileString))) + endif exit ! exit loop as we didn't find any more endif idx = min(NullLoc + 1,len(FileString)) ! Start next segment of file, but overstep end @@ -6339,6 +6350,8 @@ SUBROUTINE ReadOutputListFromFileInfo ( FileInfo, LineNum, CharAry, AryLenRead, LineNum = LineNum+1 + if (LineNum > FileInfo%NumLines) exit ! Don't overrun end of file in case no END found + END DO diff --git a/modules/openfast-library/src/FAST_Solver.f90 b/modules/openfast-library/src/FAST_Solver.f90 index 87fe207b5b..d0238567ff 100644 --- a/modules/openfast-library/src/FAST_Solver.f90 +++ b/modules/openfast-library/src/FAST_Solver.f90 @@ -461,45 +461,8 @@ SUBROUTINE IfW_InputSolve( p_FAST, m_FAST, u_IfW, p_IfW, u_AD14, u_AD, OtherSt_A ELSEIF (p_FAST%CompAero == MODULE_AD) THEN - DO K = 1,SIZE(u_AD%rotors(1)%BladeMotion) - DO J = 1,u_AD%rotors(1)%BladeMotion(k)%Nnodes - - Node = Node + 1 - u_IfW%PositionXYZ(:,Node) = u_AD%rotors(1)%BladeMotion(k)%TranslationDisp(:,j) + u_AD%rotors(1)%BladeMotion(k)%Position(:,j) - - END DO !J = 1,p%BldNodes ! Loop through the blade nodes / elements - END DO !K = 1,p%NumBl - - DO J=1,u_AD%rotors(1)%TowerMotion%nnodes - Node = Node + 1 - u_IfW%PositionXYZ(:,Node) = u_AD%rotors(1)%TowerMotion%TranslationDisp(:,J) + u_AD%rotors(1)%TowerMotion%Position(:,J) - END DO - - ! Nacelle - if (u_AD%rotors(1)%NacelleMotion%Committed) then - Node = Node + 1 - u_IfW%PositionXYZ(:,Node) = u_AD%rotors(1)%NacelleMotion%TranslationDisp(:,1) + u_AD%rotors(1)%NacelleMotion%Position(:,1) - end if - - ! Hub - if (u_AD%rotors(1)%HubMotion%Committed) then - Node = Node + 1 - u_IfW%PositionXYZ(:,Node) = u_AD%rotors(1)%HubMotion%TranslationDisp(:,1) + u_AD%rotors(1)%HubMotion%Position(:,1) - end if - - ! TailFin - if (u_AD%rotors(1)%TFinMotion%Committed) then - Node = Node + 1 - u_IfW%PositionXYZ(:,Node) = u_AD%rotors(1)%TFinMotion%TranslationDisp(:,1) + u_AD%rotors(1)%TFinMotion%Position(:,1) - end if - - ! vortex points from FVW in AD15 (should be at then end, since not "rotor dependent" - if (allocated(OtherSt_AD%WakeLocationPoints)) then - do J=1,size(OtherSt_AD%WakeLocationPoints,DIM=2) - Node = Node + 1 - u_IfW%PositionXYZ(:,Node) = OtherSt_AD%WakeLocationPoints(:,J) - enddo - end if + ! Set u_IfW%PositionXYZ needed by AeroDyn (node counter will be incremented) + call AD_SetExternalWindPositions(u_AD, OtherSt_AD, u_IfW%PositionXYZ, node, errStat, errMsg) END IF @@ -564,57 +527,9 @@ SUBROUTINE AD_InputSolve_IfW( p_FAST, u_AD, y_IfW, y_OpFM, ErrStat, ErrMsg ) else node = 1 end if - - - NumBl = size(u_AD%rotors(1)%InflowOnBlade,3) - Nnodes = size(u_AD%rotors(1)%InflowOnBlade,2) - - do k=1,NumBl - do j=1,Nnodes - u_AD%rotors(1)%InflowOnBlade(:,j,k) = y_IfW%VelocityUVW(:,node) - node = node + 1 - end do - end do - - if ( allocated(u_AD%rotors(1)%InflowOnTower) ) then - Nnodes = size(u_AD%rotors(1)%InflowOnTower,2) - do j=1,Nnodes - u_AD%rotors(1)%InflowOnTower(:,j) = y_IfW%VelocityUVW(:,node) - node = node + 1 - end do - end if - - ! Nacelle - if (u_AD%rotors(1)%NacelleMotion%NNodes > 0) then - u_AD%rotors(1)%InflowOnNacelle(:) = y_IfW%VelocityUVW(:,node) - node = node + 1 - else - u_AD%rotors(1)%InflowOnNacelle = 0.0_ReKi - end if - - if (u_AD%rotors(1)%HubMotion%NNodes > 0) then - u_AD%rotors(1)%InflowOnHub(:) = y_IfW%VelocityUVW(:,node) - node = node + 1 - else - u_AD%rotors(1)%InflowOnHub = 0.0_ReKi - end if - ! TailFin - if (u_AD%rotors(1)%TFinMotion%NNodes > 0) then - u_AD%rotors(1)%InflowOnTailFin(:) = y_IfW%VelocityUVW(:,node) - node = node + 1 - else - u_AD%rotors(1)%InflowOnTailFin = 0.0_ReKi - end if - - ! vortex points from FVW in AD15 (should be at then end, since not "rotor dependent" - if ( allocated(u_AD%InflowWakeVel) ) then - Nnodes = size(u_AD%InflowWakeVel,DIM=2) - do j=1,Nnodes - u_AD%InflowWakeVel(:,j) = y_IfW%VelocityUVW(:,node) - node = node + 1 - end do - end if + ! Set the external wind from inflowwin into the AeroDyn inputs. Node counter is incremented + call AD_GetExternalWind(u_AD, y_IfW%VelocityUVW, node, errStat, errMsg) ELSEIF ( p_FAST%CompInflow == MODULE_OpFM ) THEN node = 2 !start of inputs to AD15 diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index 2231c40040..b9b2a12b79 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -565,29 +565,8 @@ 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 - ! Blade - DO k=1,NumBl - Init%InData_IfW%NumWindPoints = Init%InData_IfW%NumWindPoints + AD%Input(1)%rotors(1)%BladeMotion(k)%NNodes - END DO - ! Tower - Init%InData_IfW%NumWindPoints = Init%InData_IfW%NumWindPoints + AD%Input(1)%rotors(1)%TowerMotion%NNodes - ! Nacelle - if (AD%Input(1)%rotors(1)%NacelleMotion%Committed) then - Init%InData_IfW%NumWindPoints = Init%InData_IfW%NumWindPoints + AD%Input(1)%rotors(1)%NacelleMotion%NNodes ! 1 point - endif - ! Hub - if (AD%Input(1)%rotors(1)%HubMotion%Committed) then - Init%InData_IfW%NumWindPoints = Init%InData_IfW%NumWindPoints + AD%Input(1)%rotors(1)%HubMotion%NNodes ! 1 point - endif - ! TailFin - if (AD%Input(1)%rotors(1)%TFinMotion%Committed) then - Init%InData_IfW%NumWindPoints = Init%InData_IfW%NumWindPoints + AD%Input(1)%rotors(1)%TFinMotion%NNodes ! 1 point - end if - ! Wake - if (allocated(AD%OtherSt(STATE_CURR)%WakeLocationPoints)) then - Init%InData_IfW%NumWindPoints = Init%InData_IfW%NumWindPoints + size(AD%OtherSt(STATE_CURR)%WakeLocationPoints,DIM=2) - end if - + ! Number of Wind points from AeroDyn, see AeroDyn.f90 + Init%InData_IfW%NumWindPoints = Init%InData_IfW%NumWindPoints + AD_NumWindPoints(AD%Input(1), AD%OtherSt(STATE_CURR)) END IF ! lidar diff --git a/reg_tests/CTestList.cmake b/reg_tests/CTestList.cmake index 0bf6839ca1..be7050b4b2 100644 --- a/reg_tests/CTestList.cmake +++ b/reg_tests/CTestList.cmake @@ -146,6 +146,15 @@ function(ad_regression TESTNAME LABEL) regression(${TEST_SCRIPT} ${AERODYN_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} ${TESTNAME} "${LABEL}") endfunction(ad_regression) +# aerodyn-Py +function(py_ad_regression TESTNAME LABEL) + set(TEST_SCRIPT "${CMAKE_CURRENT_LIST_DIR}/executeAerodynPyRegressionCase.py") + 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}") +endfunction(py_ad_regression) + # beamdyn function(bd_regression TESTNAME LABEL) set(TEST_SCRIPT "${CMAKE_CURRENT_LIST_DIR}/executeBeamdynRegressionCase.py") @@ -295,6 +304,7 @@ ad_regression("ad_BAR_OLAF" "aerodyn;bem") ad_regression("ad_BAR_SineMotion" "aerodyn;bem") ad_regression("ad_BAR_SineMotion_UA4_DBEMT3" "aerodyn;bem") ad_regression("ad_BAR_RNAMotion" "aerodyn;bem") +py_ad_regression("py_ad_5MW_OC4Semi_WSt_WavesWN" "aerodyn;bem;python") # BeamDyn regression tests bd_regression("bd_5MW_dynamic" "beamdyn;dynamic") diff --git a/reg_tests/executeAerodynPyRegressionCase.py b/reg_tests/executeAerodynPyRegressionCase.py new file mode 100644 index 0000000000..34dd3f551b --- /dev/null +++ b/reg_tests/executeAerodynPyRegressionCase.py @@ -0,0 +1,137 @@ +# +# Copyright 2017 National Renewable Energy Laboratory +# +# Licensed under the Apache License, Version 2.0 (the "License"); +# you may not use this file except in compliance with the License. +# You may obtain a copy of the License at +# +# http://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, software +# distributed under the License is distributed on an "AS IS" BASIS, +# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +# See the License for the specific language governing permissions and +# limitations under the License. +# + +""" + This program executes AeroDyn and a regression test for a single test case. + The test data is contained in a git submodule, r-test, which must be initialized + prior to running. See the r-test README or OpenFAST documentation for more info. + + Get usage with: `executeAerodynPyRegressionCase.py -h` +""" + +import os +import sys +basepath = os.path.dirname(os.path.abspath(__file__)) +sys.path.insert(0, os.path.sep.join([basepath, "lib"])) +import argparse +import numpy as np +import shutil +import glob +import subprocess +import rtestlib as rtl +import openfastDrivers +import pass_fail +from errorPlotting import exportCaseSummary + +##### Main program + +### Store the python executable for future python calls +pythonCommand = sys.executable + +### Verify input arguments +parser = argparse.ArgumentParser(description="Executes OpenFAST and a regression test for a single test case.") +parser.add_argument("caseName", metavar="Case-Name", type=str, nargs=1, help="The name of the test case.") +parser.add_argument("executable", metavar="AeroDyn-Inflow-Python", type=str, nargs=1, help="The path to the AeroDyn driver executable.") +parser.add_argument("sourceDirectory", metavar="path/to/openfast_repo", type=str, nargs=1, help="The path to the OpenFAST repository.") +parser.add_argument("buildDirectory", metavar="path/to/openfast_repo/build", type=str, nargs=1, help="The path to the OpenFAST repository build directory.") +parser.add_argument("rtol", metavar="Relative-Tolerance", type=float, nargs=1, help="Relative tolerance to allow the solution to deviate; expressed as order of magnitudes less than baseline.") +parser.add_argument("atol", metavar="Absolute-Tolerance", type=float, nargs=1, help="Absolute tolerance to allow small values to pass; expressed as order of magnitudes less than baseline.") +parser.add_argument("-p", "-plot", dest="plot", action='store_true', help="bool to include plots in failed cases") +parser.add_argument("-n", "-no-exec", dest="noExec", action='store_true', help="bool to prevent execution of the test cases") +parser.add_argument("-v", "-verbose", dest="verbose", action='store_true', help="bool to include verbose system output") + +args = parser.parse_args() + +caseName = args.caseName[0] +executable = args.executable[0] +sourceDirectory = args.sourceDirectory[0] +buildDirectory = args.buildDirectory[0] +rtol = args.rtol[0] +atol = args.atol[0] +plotError = args.plot if args.plot is False else True +noExec = args.noExec if args.noExec is False else True +verbose = args.verbose if args.verbose is False else True + +# validate inputs +rtl.validateExeOrExit(executable) +rtl.validateDirOrExit(sourceDirectory) +if not os.path.isdir(buildDirectory): + os.makedirs(buildDirectory) + +### Build the filesystem navigation variables for running the test case +regtests = os.path.join(sourceDirectory, "reg_tests") +lib = os.path.join(regtests, "lib") +rtest = os.path.join(regtests, "r-test") +moduleDirectory = os.path.join(rtest, "modules", "aerodyn") +inputsDirectory = os.path.join(moduleDirectory, caseName) +targetOutputDirectory = os.path.join(inputsDirectory) +testBuildDirectory = os.path.join(buildDirectory, caseName) + +# verify all the required directories exist +if not os.path.isdir(rtest): + rtl.exitWithError("The test data directory, {}, does not exist. If you haven't already, run `git submodule update --init --recursive`".format(rtest)) +if not os.path.isdir(targetOutputDirectory): + rtl.exitWithError("The test data outputs directory, {}, does not exist. Try running `git submodule update`".format(targetOutputDirectory)) +if not os.path.isdir(inputsDirectory): + rtl.exitWithError("The test data inputs directory, {}, does not exist. Verify your local repository is up to date.".format(inputsDirectory)) + + +# create the local output directory and initialize it with input files +rtl.copyTree(inputsDirectory, testBuildDirectory, renameDict={'py_ad_driver.out':'py_ad_driver_ref.out'}) + # , excludeExt=['.out','.outb']) + +### Run aerodyn on the test case +if not noExec: + caseInputFile = os.path.join(testBuildDirectory, "py_ad_driver.py") + returnCode = openfastDrivers.runAerodynDriverCase(caseInputFile, executable, verbose=verbose) + if returnCode != 0: + sys.exit(returnCode*10) + +###Build the filesystem navigation variables for running the regression test +# For multiple turbines, test turbine 2, for combined cases, test case 4 +localOutFile = os.path.join(testBuildDirectory, "py_ad_driver.out") +baselineOutFile = os.path.join(targetOutputDirectory, os.path.basename(localOutFile)) +rtl.validateFileOrExit(localOutFile) +rtl.validateFileOrExit(baselineOutFile) + +testData, testInfo, _ = pass_fail.readFASTOut(localOutFile) +baselineData, baselineInfo, _ = pass_fail.readFASTOut(baselineOutFile) + +passing_channels = pass_fail.passing_channels(testData.T, baselineData.T, rtol, atol) +passing_channels = passing_channels.T + +norms = pass_fail.calculateNorms(testData, baselineData) + +# export all case summaries +channel_names = testInfo["attribute_names"] +exportCaseSummary(testBuildDirectory, caseName, channel_names, passing_channels, norms) + +# passing case +if np.all(passing_channels): + sys.exit(0) + +# failing case +if plotError: + from errorPlotting import finalizePlotDirectory, plotOpenfastError + for channel in testInfo["attribute_names"]: + try: + plotOpenfastError(localOutFile, baselineOutFile, channel, rtol, atol) + except: + error = sys.exc_info()[1] + print("Error generating plots: {}".format(error)) + finalizePlotDirectory(localOutFile, testInfo["attribute_names"], caseName) + +sys.exit(1) diff --git a/reg_tests/r-test b/reg_tests/r-test index 86de1d6de6..09f62ae78d 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit 86de1d6de6d1d27e4a0e01f5322c877035637438 +Subproject commit 09f62ae78d4d12fc22602050c72b1e1e965b6d1c diff --git a/vs-build/AeroDyn/AeroDyn_Driver.vfproj b/vs-build/AeroDyn/AeroDyn_Driver.vfproj index 873521d2a2..382653666f 100644 --- a/vs-build/AeroDyn/AeroDyn_Driver.vfproj +++ b/vs-build/AeroDyn/AeroDyn_Driver.vfproj @@ -192,6 +192,37 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build/AeroDyn_Inflow_c_lib/AeroDyn_Inflow_c_lib.sln b/vs-build/AeroDyn_Inflow_c_lib/AeroDyn_Inflow_c_lib.sln new file mode 100644 index 0000000000..1e6d38c53e --- /dev/null +++ b/vs-build/AeroDyn_Inflow_c_lib/AeroDyn_Inflow_c_lib.sln @@ -0,0 +1,61 @@ + +Microsoft Visual Studio Solution File, Format Version 12.00 +# Visual Studio 2013 +VisualStudioVersion = 12.0.40629.0 +MinimumVisualStudioVersion = 10.0.40219.1 +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "AeroDyn_Inflow_c_lib", "AeroDyn_Inflow_c_lib.vfproj", "{5D991B19-D4F1-4F29-8A9D-FC36DFF07290}" + ProjectSection(ProjectDependencies) = postProject + {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16} = {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16} + EndProjectSection +EndProject +Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "FAST_Registry", "..\Registry\FAST_Registry.vcxproj", "{DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}" +EndProject +Global + GlobalSection(SolutionConfigurationPlatforms) = preSolution + Debug_Double|Win32 = Debug_Double|Win32 + Debug_Double|x64 = Debug_Double|x64 + Debug|Win32 = Debug|Win32 + Debug|x64 = Debug|x64 + Release_Double|Win32 = Release_Double|Win32 + Release_Double|x64 = Release_Double|x64 + Release|Win32 = Release|Win32 + Release|x64 = Release|x64 + EndGlobalSection + GlobalSection(ProjectConfigurationPlatforms) = postSolution + {5D991B19-D4F1-4F29-8A9D-FC36DFF07290}.Debug_Double|Win32.ActiveCfg = Debug_Double|Win32 + {5D991B19-D4F1-4F29-8A9D-FC36DFF07290}.Debug_Double|Win32.Build.0 = Debug_Double|Win32 + {5D991B19-D4F1-4F29-8A9D-FC36DFF07290}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {5D991B19-D4F1-4F29-8A9D-FC36DFF07290}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {5D991B19-D4F1-4F29-8A9D-FC36DFF07290}.Debug|Win32.ActiveCfg = Debug|Win32 + {5D991B19-D4F1-4F29-8A9D-FC36DFF07290}.Debug|Win32.Build.0 = Debug|Win32 + {5D991B19-D4F1-4F29-8A9D-FC36DFF07290}.Debug|x64.ActiveCfg = Debug|x64 + {5D991B19-D4F1-4F29-8A9D-FC36DFF07290}.Debug|x64.Build.0 = Debug|x64 + {5D991B19-D4F1-4F29-8A9D-FC36DFF07290}.Release_Double|Win32.ActiveCfg = Release_Double|Win32 + {5D991B19-D4F1-4F29-8A9D-FC36DFF07290}.Release_Double|Win32.Build.0 = Release_Double|Win32 + {5D991B19-D4F1-4F29-8A9D-FC36DFF07290}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {5D991B19-D4F1-4F29-8A9D-FC36DFF07290}.Release_Double|x64.Build.0 = Release_Double|x64 + {5D991B19-D4F1-4F29-8A9D-FC36DFF07290}.Release|Win32.ActiveCfg = Release|Win32 + {5D991B19-D4F1-4F29-8A9D-FC36DFF07290}.Release|Win32.Build.0 = Release|Win32 + {5D991B19-D4F1-4F29-8A9D-FC36DFF07290}.Release|x64.ActiveCfg = Release|x64 + {5D991B19-D4F1-4F29-8A9D-FC36DFF07290}.Release|x64.Build.0 = Release|x64 + {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug_Double|Win32.ActiveCfg = Release|Win32 + {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug_Double|Win32.Build.0 = Release|Win32 + {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug_Double|x64.ActiveCfg = Release|Win32 + {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug_Double|x64.Build.0 = Release|Win32 + {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug|Win32.ActiveCfg = Release|Win32 + {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug|Win32.Build.0 = Release|Win32 + {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug|x64.ActiveCfg = Release|Win32 + {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug|x64.Build.0 = Release|Win32 + {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release_Double|Win32.ActiveCfg = Release|Win32 + {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release_Double|Win32.Build.0 = Release|Win32 + {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release_Double|x64.ActiveCfg = Release|Win32 + {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release_Double|x64.Build.0 = Release|Win32 + {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release|Win32.ActiveCfg = Release|Win32 + {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release|Win32.Build.0 = Release|Win32 + {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release|x64.ActiveCfg = Release|Win32 + {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release|x64.Build.0 = Release|Win32 + EndGlobalSection + GlobalSection(SolutionProperties) = preSolution + HideSolutionNode = FALSE + EndGlobalSection +EndGlobal diff --git a/vs-build/AeroDyn_Inflow_c_lib/AeroDyn_Inflow_c_lib.vfproj b/vs-build/AeroDyn_Inflow_c_lib/AeroDyn_Inflow_c_lib.vfproj new file mode 100644 index 0000000000..a839df194b --- /dev/null +++ b/vs-build/AeroDyn_Inflow_c_lib/AeroDyn_Inflow_c_lib.vfproj @@ -0,0 +1,1027 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build/FASTlib/FASTlib.vfproj b/vs-build/FASTlib/FASTlib.vfproj index 7f6a269ff7..699b384c91 100644 --- a/vs-build/FASTlib/FASTlib.vfproj +++ b/vs-build/FASTlib/FASTlib.vfproj @@ -225,6 +225,44 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -417,6 +455,7 @@ +